module Util = struct




(**
§
*)

(**

Introduction

 *)

(**
*)





(** The mathematician will find in this module several elementary tools used in the other modules of the ocamlmath library.

Comments

This module is distributed under the same licence as Ocaml.

§

La mathématicienne ou le mathématicien trouvera dans ce module différents outils élémentaires utilisés dans les autres modules de la bibliothèque ocamlmath.

Commentaires

Ce module est distribué selon la même licence qu'Ocaml.

Copyright Stéphane Grognet
Laboratoire de mathématiques Jean Leray UMR 6629 CNRS
Fédération de recherche mathématique des Pays de la Loire
IREM des Pays de la Loire - Université de Nantes
version 0.2
*)

(** @version 0.2 *)

(** @author Stéphane Grognet *)

(** @since 2012, 2013 *)





(**
§
*)

(**

Constructions minimales sur les entiers et réels

Minimal constructions on integer and real numbers

 *)

(**
*)





(** 
int_copy integer
*)

let int_copy = function (x:int) -> x

(** 
big_int_copy big_integer
*)

let big_int_copy = function (x:Big_int.big_int) ->
 Big_int.add_big_int Big_int.zero_big_int x ;;

(** 
big integer integer
*)

let big = Big_int.big_int_of_int ;;

(** 
small big_integer
*)

let small = Big_int.int_of_big_int ;;

(** 
round_num number
*)

let round_num = function (x:Num.num) ->
 let xx = Num.integer_num x in
  let y = Num.mult_num ( Num.num_of_int 2 ) ( Num.sub_num x xx ) in
   let yy = Num.integer_num y in
    Num.add_num xx yy ;;

(** 
adhoc_division integer1 integer2
*)

let adhoc_division = fun (x:int) (y:int) ->
 if y <> 0 then x / y
 else 0 ;;


(** 
int_sign integer
*)

let int_sign = function (x:int) ->
 compare x 0 ;;

(** 
int_truncate base number
*)

let int_truncate = fun (b:int) (x:int) ->
 if x > b then b
 else
  begin
   if x < - b then - b
   else
    x
  end ;;

(** 
int_gcd integer1 integer2
*)

let int_gcd = fun (p:int) (q:int) ->
 Big_int.int_of_big_int  ( Big_int.gcd_big_int ( Big_int.big_int_of_int p ) ( Big_int.big_int_of_int q ) ) ;;

(** 
int_identity integer
*)

let int_identity = function (x:int) -> x ;;

(** 
int_sqrt integer
*)

let int_sqrt = function (x:int) ->
 small ( Big_int.sqrt_big_int ( big x ) ) ;;

(** 
int_power exponent integer
*)

let rec int_power = fun (n:int) (x:int) ->
 match compare n 0 with
 | 0 -> 1
 | negative when negative < 0 -> failwith "Negative exponent in Util.int_power."
 | _ ->
  begin
   match n with
   | 1 -> x
   | 2 -> x * x
   | _ ->
    begin
     match n mod 2 with
     | 0 ->
      begin
       let y = int_power ( n / 2 ) x in
        y * y
      end
     | _ -> x * ( int_power ( pred n ) x )
    end
  end ;;
 
(** 
ilog integer
*)

let ilog = function (x:int) ->
 let result = ref 0
 and y = ref x in
  while !y > 0 do
   incr result ;
   y := !y lsr 1 ;
  done ;
  !result ;;



(** 
float_zero float
*)

let float_zero = function (x:float) -> 0. ;;

(** 
float_one float
*)

let float_one = function (x:float) -> 1. ;;


(** 
ulp real
Unit in the last place. This function is described by William Kahan in http://www.cs.berkeley.edu/~wkahan/LOG10HAF.TXT.

Unité dans la position la moins significative. Cette fonction est décrite par William Kahan dans http://www.cs.berkeley.edu/~wkahan/LOG10HAF.TXT. *)


let ulp = function (x:float) ->
 let u = abs_float x in
  match u with
  | v when v < 5.0e-308 -> 5.0e-324
(** 1024. -. 53. = 971. *)

  | v when v > 9.0e307 -> 2.** 971.
  | _ ->
   begin
    let v = ( 0.7 *. epsilon_float ) *. u in
     min ( ( v +. u ) -. u ) ( ( v -. u ) +. u )
   end ;;

(** 
float_sign float
*)

let float_sign = function (x:float) ->
 float ( compare x 0. ) ;;

(** 
float_identity float
*)

let float_identity = function (x:float) -> x ;;

(** 
round real
*)

let round = function (x:float) ->
 let n = int_of_float ( x +. x ) in
  n / 2 + n mod 2 ;;

(** 
frac real
*)

let frac = function (x:float) ->
 fst ( modf x ) ;;

(** 
float_pos_part float
*)

let float_pos_part = function (x:float) -> ( x +. ( abs_float x ) ) /. 2. ;;

(** 
int_float_power integer float
*)

let rec int_float_power = fun (n:int) (x:float) ->
 match compare n 0 with
 | 0 -> 1.
 | negative when negative < 0 -> int_float_power ( abs n ) ( 1. /. x )
 | _ ->
  begin
   match n with
   | 1 -> x
   | 2 -> x *. x
   | _ ->
    begin
     let y = int_float_power ( n / 2 ) x in
      match n mod 2 with
      | 0 -> y *. y
      | _ -> x *. y *. y
    end
  end ;;
 

(** The factorial function is defined in a tail recursive way.

La factorielle est définie de manière récursive terminale. *)



(** 
fact_aux stack init
*)

let rec fact_aux = fun (x:int) (y:int) -> match y with
 | 0 -> x
 | 1 -> x
 | _ -> fact_aux ( x * y ) ( pred y ) ;;

(** 
fact integer
*)

let fact = function (x:int) -> fact_aux 1 ( abs x ) ;;


(** 
float_max real1 real2
*)

let float_max = fun (x:float) (y:float) -> if x > y then x else y ;;

(** 
float_min real1 real2
*)

let float_min = fun (x:float) (y:float) -> if y > x then x else y ;;


(** 
int_max int1 int2
*)

let int_max = fun (x:int) (y:int) -> if x > y then x else y ;;

(** 
int_min int1 int2
*)

let int_min = fun (x:int) (y:int) -> if y > x then x else y ;;




(**
§
*)

(**

Constructions minimales sur les vecteurs réels

Minimal constructions on real vectors

 *)

(**
*)





(** 
vector_zero dimension
*)

let vector_zero = fun n (x:float) -> Array.make n 0. ;;

(** 
vector_one dimension float
*)

let vector_one = fun n (x:float) -> Array.make n 1. ;;

(** 
vector_float_prod_3 vector1 vector2
*)

let vector_float_prod_3 = fun (v1:float array) (v2:float array) ->
 [| v1.(1) *. v2.(2) -. v1.(2) *. v2.(1) ;
    v1.(2) *. v2.(0) -. v1.(0) *. v2.(2) ;
    v1.(0) *. v2.(1) -. v1.(1) *. v2.(0) |] ;;




(**
§
*)

(**

Constructions diverses

Miscellaneous constructions

 *)

(**
*)





(** 
print_bool boolean
*)

let print_bool = function (x:bool) ->
 print_string ( string_of_bool x ) ;;

(** 
append_char string character
*)

let append_char = fun (s:string) (c:char) ->
 s ^ ( String.make 1 c ) ;;

(** 
string_eq string1 string2
*)

let string_eq = fun x y ->
 ( String.compare x y ) = 0 ;;

(** 
string_tail string
*)

let string_tail = function (s:string) ->
 String.sub s 1 ( pred ( String.length s ) ) ;;

(** 
deverminage ()
L'erreur Exception: Invalid_argument "index out of bounds". arrive fréquemment quand on fait de mauvais dimensionnenments de matrices ou de vecteurs. Placer cette instruction à différents endroits du code peut permettre de localiser le problème. *)

let deverminage = function () ->
 print_string "Jusqu'ici, tout va bien !" ;
 print_newline () ;;

(** 
degugging ()
The error Exception: Invalid_argument "index out of bounds". is frequently seen when matrices or vectors are ill-dimensioned. Placing this instruction at different places in the code may help to situate the issue. *)

let debugging = function () ->
 print_string "So far so good !" ;
 print_newline () ;;




(**
§
*)

(**

Constructions polymorphes sur les structures élémentaires d'Ocaml

Polymorphic constructions on elementary structures of Ocaml

 *)

(**
*)





(** Polymorphic functions are reputed to be slow.

Les fonctions polymorphes sont réputés lentes.*)


(**
§
*)



(** primo triple *)

let primo = function ( x , y , z ) -> x ;;

(** secundo triple *)

let secundo = function ( x , y , z ) -> y ;;

(** tertio triple *)

let tertio = function ( x , y , z ) -> z ;;


(** 
vector_print coeff_print vector
*)

let vector_print = fun (coeff_print:'a -> unit) (v:'a array) ->
 let rr = Array.length v - 1 in
  print_string "[| " ;
  for i = 0 to ( rr - 1 ) do
   coeff_print v.(i) ; print_string " ; " 
  done ;
  coeff_print v.(rr) ;
  print_string " |]" ;
  print_newline () ;;

(** 
bare_vector_print coeff_print vector
*)

let bare_vector_print = fun (coeff_print:'a -> unit) (v:'a array) ->
 let rr = Array.length v - 1 in
  print_string "[|" ;
  for i = 0 to ( rr - 1 ) do
   coeff_print v.(i) ; print_string " " 
  done ;
  coeff_print v.(rr) ;
  print_string "|]" ;;

(** 
vector_to_string coeff_to_string beginning separator ending vector
*)

let vector_to_string = fun (coeff_to_string:'a -> string) (beginning:string) (separator:string) (ending:string) (v:'a array) ->
 try
  begin
   let rr = Array.length v - 1
   and s = ref beginning in
    for i = 0 to ( rr - 1 ) do
     s := !s ^ ( coeff_to_string v.(i) ) ^ separator
    done ;
    s := !s ^ ( coeff_to_string v.(rr) ) ^ ending ;
    !s
  end
 with _ ->
  beginning ^ ending ;;

(** 
bare_vector_to_string coeff_to_string vector
*)

let bare_vector_to_string = fun (coeff_to_string:'a -> string) (v:'a array) ->
 vector_to_string coeff_to_string "[|" " " "|]" v ;;

(** 
vector_of_string coeff_of_string beginning separator ending string
*)

let vector_of_string = fun (coeff_of_string:string -> 'a) (beginning:string) (separator:string) (ending:string) (s:string) ->
 let ls = String.length s
 and lb = String.length beginning
 and le = String.length ending in
  let st = String.sub s lb ( ls - lb - le ) in
   let listing = Str.split ( Str.regexp_string separator ) st in
    let a = Array.of_list listing in
     Array.map coeff_of_string a ;;

(** 
bare_vector_of_string coeff_of_string string
*)

let bare_vector_of_string = fun (coeff_of_string:string -> 'a) (s:string) ->
 vector_of_string coeff_of_string "[|" " " "|]" s ;;


(** 
extract_even table
*)

let extract_even = function (table:'a array) ->
 let r = ( Array.length table ) / 2 in
  let result = Array.make r table.(0) in
   for i = 0 to pred r do
    result.(i) <- table.( 2 * i )
   done ;
   result ;;

(** 
extract_odd table
*)

let extract_odd = function (table:'a array) ->
 let r = ( 1 + ( Array.length table ) ) / 2 in
  let result = Array.make r table.(0) in
   for i = 0 to pred r do
    result.(i) <- table.( 2 * i + 1 )
   done ;
   result ;;

(** 
extract_every_other number table
*)

let extract_every_other = fun (n:int) (table:'a array) ->
 let r = ( Array.length table ) / n in
  let result = Array.make r table.(0) in
   for i = 0 to pred r do
    result.(i) <- table.( n * i )
   done ;
   result ;;

(** 
array_combine array1 array2
*)

let array_combine = fun a b ->
 let r = Array.length a
 and s = Array.length b in
  if r != s then failwith "Different array lengths in Util.array_combine." ;
  if r = 0 then
   [| |]
  else
   begin
    let v = Array.make r ( a.(0) , b.(0) ) in
     for i = 1 to pred r do
      v.(i) <- ( a.(i) , b.(i) )
     done ;
     v
   end ;;

(** 
array_split array
*)

let array_split = function a ->
 ( Array.map fst a , Array.map snd a ) ;;


(** 
list_non_empty list
*)

let list_non_empty = function (l:'a list) ->
 match l with
 | [] -> false
 | _ -> true ;;

(** 
list_is_empty list
*)

let list_is_empty = function (l:'a list) ->
 match l with
 | [] -> true
 | _ -> false ;;

(** 
array_is_empty array
*)

let array_is_empty = function (a:'a array) ->
 Array.length a = 0 ;;


(** 
reverse_array array
*)

let reverse_array = function a ->
 let r = Array.length a in
  let pr = pred r in
   Array.init r ( function i -> a.( pr - i ) ) ;;


(** 
lexico_compare comparison array1 array2
*)

let lexico_compare = fun (cmp:'a -> 'a -> int) (x:'a array) (y:'a array) ->
 let lx = Array.length x
 and ly = Array.length y
 and result = ref 0 in
  let ll = min lx ly
  and i = ref 0 in
   while ( !result = 0 ) && ( !i < ll ) do
    result := cmp x.(!i) y.(!i) ;
    incr i
   done ;
   if ( !result = 0 ) && ( lx < ly ) then
    result := -1 ;
   if ( !result = 0 ) && ( lx > ly ) then
    result := 1 ;
   !result ;;

(** 
array_eq coeff_equality array1 array2
*)

let array_eq = fun (eq:'a -> 'a -> bool) (v:'a array) (w:'a array) ->
 let f = fun i x -> eq v.(i) x in
  let test = Array.mapi f w in
   Array.fold_left ( && ) true test ;;

(** 
array_eq_zero coeff_nullity array
*)

let array_eq_zero = fun (eq_zero:'a -> bool) (v:'a array) ->
 let test = Array.map eq_zero v in
  Array.fold_left ( && ) true test ;;


(** 
vector_max vector
*)

let vector_max = function v -> Array.fold_left max v.(0) v ;;

(** 
vector_min vector
*)

let vector_min = function v -> Array.fold_left min v.(0) v ;;


(** 
maximum comparison x y
*)

let maximum = fun (cmp:'a -> 'a -> int) (x:'a) (y:'a) ->
 if cmp x y < 0 then
  y
 else
  x ;;

(** 
minimum comparison x y
*)

let minimum = fun (cmp:'a -> 'a -> int) (x:'a) (y:'a) ->
 if cmp x y > 0 then
  y
 else
  x ;;


(** 
array_maximum comparison array
*)

let array_maximum = fun (cmp:'a -> 'a -> int) (v:'a array) ->
 if Array.length v = 0 then failwith "Empty array in Util.array_maximum." ;
 let x = ref v.(0)
 and r = Array.length v in
  for i = 1 to pred r do
   let y = v.(i) in
    if cmp y !x > 0 then
     x := y
  done ;
  !x ;;

(** 
array_minimum comparison array
*)

let array_minimum = fun (cmp:'a -> 'a -> int) (v:'a array) ->
 if Array.length v = 0 then failwith "Empty array in Util.array_minimum." ;
 let x = ref v.(0)
 and r = Array.length v in
  for i = 1 to pred r do
   let y = v.(i) in
    if cmp y !x < 0 then
     x := y
  done ;
  !x ;;

(** 
list_maximum comparison list
*)

let list_maximum = fun (cmp:'a -> 'a -> int) (l:'a list) ->
 let rec aux = fun cmp accu m ->
  match m with
  | [] -> accu
  | x :: n -> aux cmp ( maximum cmp x accu ) n in
  match l with
  | [] -> failwith "Empty list in Util.list_maximum."
  | x :: m -> aux cmp x m ;;


(** 
list_minimum comparison list
*)

let list_minimum = fun (cmp:'a -> 'a -> int) (l:'a list) ->
 let rec aux = fun cmp accu m ->
  match m with
  | [] -> accu
  | x :: n -> aux cmp ( minimum cmp x accu ) n in
  match l with
  | [] -> failwith "Empty list in Util.list_minimum."
  | x :: m -> aux cmp x m ;;


(** 
array_find_first predicate vector
This function returns -1 if it does not find:

Cette fonction retourne -1 s'il ne trouve pas. *)


let array_find_first = fun (p:'a -> bool) (v:'a array) ->
 let r = Array.length v and index = ref (-1) and i = ref 0 in
  while  !i < r do
   if p v.(!i) then (index := !i ; i := r) else i := !i + 1 ; 
  done ;
  !index ;;


(** 
array_find_last predicate vector
This function returns -1 if it does not find:

Cette fonction retourne -1 s'il ne trouve pas. *)


let array_find_last = fun (p:'a -> bool) (v:'a array) ->
 let r = Array.length v and index = ref (-1) in
  let i = ref ( pred r ) in
   while  !i >= 0 do
    if p v.(!i) then (index := !i ; i := -1) else i := !i - 1 ; 
   done ;
   !index ;;


(** 
vector_find_last equality element vector
vector_find_last returns -1 if it does not find:

vector_find_last retourne -1 s'il ne trouve pas. *)


let vector_find_last = fun eq x v -> 
 let r = Array.length v and index = ref (-1) in
  let i = ref (r - 1) in
   while  !i >= 0 do
    if eq x v.(!i) then (index := !i ; i := -1) else i := !i - 1 ; 
   done ;
   !index ;;

(** 
vector_find_first equality element vector
vector_find_first returns -1 if it does not find:

vector_find_first retourne -1 s'il ne trouve pas. *)


let vector_find_first = fun eq x v ->
 let r = Array.length v and index = ref (-1) and i = ref 0 in
  while  !i < r do
   if eq x v.(!i) then (index := !i ; i := r) else i := !i + 1 ; 
  done ;
 !index ;;

(** 
vector_find_twin equality element vector
vector_find_first returns -1 if it does not find:

vector_find_twin retourne -1 s'il ne trouve pas. *)


let vector_find_twin = fun eq x v ->
 let r = Array.length v and index = ref (-1) and i = ref 0 in
  while  !i <= int_min (r - 1) ( int_of_float ( ceil ( (float r) /. 2. ) ) )  do
   if x = v.(!i) then (index := !i ; i := 1 + r)
   else
    begin
     let j = r - 1 - !i in
     if eq x v.(j) then (index := j ; i := 1 + r) else i := !i + 1 ; 
    end
  done ;
 !index ;;

(** 
vector_find_all equality element vector
vector_find_all returns [||] if it does not find:

vector_find_all retourne [||] s'il ne trouve pas.*)


let vector_find_all = fun eq x v -> 
 let r = Array.length v and index = ref [||] in
  for i = 0 to r - 1 do
   if eq x v.(i) then (index := Array.append !index [|i|] ; ())
  done ;
 !index ;;

(** 
vector_filter predicate vector
*)

let vector_filter = fun (p:int -> bool) v ->
 let result = ref [] in
  for i = 0 to pred ( Array.length v ) do
   if p i then
    result := ( i , v.(i) ) :: !result
  done ;
  !result ;;


(** 
list_accumulate first_factor_comparison second_factor_addition combined_element ordered_combined_list
The list lis is supposed to be sorted according to cmp with respect to the first factors.

La liste lis est supposée triée selon cmp par rapport aux premiers facteurs. *)


let list_accumulate = fun (cmp:'a -> 'a -> int) (add:'b -> 'b -> 'b) (( i , x ) as y:'a * 'b) (lis:('a * 'b) list) ->
 let p = function z -> cmp i ( fst z ) = 0
 and comparison = fun z zz -> cmp ( fst z ) ( fst zz )
 and add_ad_hoc = fun a b -> ( fst a , add ( snd a ) ( snd b ) ) in
  let ( with_i , without_i ) = List.partition p lis in
   let z = List.fold_left add_ad_hoc y with_i in
    List.merge comparison [ z ] without_i ;;


(** The collision functions take two ordered families Y and Z into argument and provide four such ones. The first value is Y \ Z and the second is Z \ Y and the third is Y inter Z as seen from Y, the last is Y inter Z as seen from Z. The order is either globally reversed or globally respected. A total preorder is enough. These functions are tail-recursive.

Les fonctions de collisions prennent deux familles ordonnées Y et Z en argument et en renvoient quatre. La première valeur est Y \ Z, la deuxième est Z \ Y, la troisième est Y inter Z vu par Y et la dernière est Y inter Z vu par Z. L'ordre est soit globalement renversé soit globalement respecté. Un préordre total suffit. Ces fonctions sont récursives terminales. *)



(** 
list_collision_aux comparison accumulator list1 list2
*)

let rec list_collision_aux = fun (cmp:'a -> 'a -> int) (accu:'a list array) (y:'a list) (z:'a list) ->
 if ( list_is_empty y ) || ( list_is_empty z ) then [| List.append y accu.(0) ; List.rev_append z accu.(1) ; accu.(2) ; accu.(3) |]
 else
  begin
   let xy = List.hd y
   and xz = List.hd z in
    match cmp xy xz with
    | 0 -> list_collision_aux cmp [| accu.(0) ; accu.(1) ; xy :: accu.(2) ; xz :: accu.(3)|] ( List.tl y ) ( List.tl z )
    | 1 -> list_collision_aux cmp [| accu.(0) ; xz :: accu.(1) ; accu.(2) ; accu.(3) |] y ( List.tl z )
    | _ -> list_collision_aux cmp [| xy :: accu.(0) ; accu.(1) ; accu.(2) ; accu.(3) |] ( List.tl y ) z
  end ;;

(** 
reverse_list_collision comparison list1 list2
*)

let reverse_list_collision = fun (cmp:'a -> 'a -> int) (y:'a list) (z:'a list) ->
 let c = fun x y -> cmp y x in
  let f = function x -> List.fast_sort c x in
   Array.map f ( list_collision_aux cmp ( Array.make 4 [] ) y z ) ;;

(** 
list_collision comparison list1 list2
*)

let list_collision = fun (cmp:'a -> 'a -> int) (y:'a list) (z:'a list) ->
 Array.map List.rev ( reverse_list_collision cmp y z ) ;;

(** 
reverse_array_collision comparison array1 array2
*)

let reverse_array_collision = fun (cmp:'a -> 'a -> int) (y:'a array) (z:'a array) ->
 Array.map Array.of_list ( reverse_list_collision cmp ( Array.to_list y ) ( Array.to_list z ) ) ;;

(** 
array_collision comparison array1 array2
*)

let array_collision = fun (cmp:'a -> 'a -> int) (y:'a array) (z:'a array) ->
 Array.map ( function x -> Array.of_list ( List.rev x ) ) ( reverse_list_collision cmp ( Array.to_list y ) ( Array.to_list z ) ) ;;


(** 
transpose matrix
*)

let transpose = function m ->
 let r = Array.length m
 and c = Array.length m.(0) in
  if ( r = 0 ) || ( c = 0 ) then [| [| |] |]
  else
   begin
    let mm = Array.make_matrix c r m.(0).(0)
    and rr = pred r in
     for i = 0 to pred c do
      let row_output = mm.(i) in
       for j = 0 to rr do
        row_output.(j) <- m.(j).(i)
       done ;
     done ;
     mm
   end ;;


(** 
array_first
*)

let array_first = function a ->
 a.(0) ;;

(** 
array_last array
*)

let array_last = function a ->
 if Array.length a = 0 then failwith "Empty array in Util.array_last." ;
 a.( pred ( Array.length a ) ) ;;

(** 
array_tail array
*)

let array_tail = function (a:'a array) ->
 Array.sub a 1 ( pred ( Array.length a ) ) ;;

(** 
array_end index array
*)

let array_end = fun (i:int) (a:'a array) ->
 try
  let r = ( Array.length a ) - i in
   Array.sub a i r
 with _ -> [| |] ;;

(** 
array_forget index array
*)

let array_forget = fun (k:int) (a:'a array) ->
 if ( k < 0 ) || ( k >= Array.length a ) then
  failwith "Bad index in Util.array_forget." ;
 let b = Array.sub a 0 k
 and c = array_end ( succ k ) a in
  Array.append b c ;;

(** 
array_insert index value array
*)

let array_insert = fun (k:int) (x:'a) (a:'a array) ->
 let b = Array.sub a 0 k
 and c = array_end k a in
   Array.concat [ b ; [| x |] ; c ] ;;


(** 
array_cut table array
*)

let array_cut = fun (table:int array) (a:'a array) ->
 let rr = Array.fold_left ( + ) 0 table in
  if Array.length a < rr then failwith "Array of bad length in Util.array_cut." ;
  let r = Array.length table
  and accu = ref 0 in
   let b = Array.make_matrix r 0 a.(0) in
    for i = 0 to pred r do
     let shift = table.(i) in
      b.(i) <- Array.sub a !accu shift ;
      accu := !accu + shift ;
    done ;
    b ;;


(** 
array_guarded_cut thickness table array
*)

let array_guarded_cut = fun (e:int) (table:int array) (a:'a array) ->
 let r = Array.length table
 and i = ref 0
 and accu = ref 0 in
  if e = 0 then Array.map ( Array.make 1 ) a
  else
   begin
    let b = Array.make_matrix r 0 a.(0) in
     while !i < r do
      let shift = table.(!i) in
       begin
        try
         b.(!i) <- Array.sub a !accu shift
        with _ ->
         begin
          try
           b.(!i) <- array_end !accu a
          with _ -> ()
         end
       end ;
       accu := !accu + shift ;
      incr i ;
     done ;
     b
   end ;;

(** 
array_cut table array
*)

let array_cut = fun (table:int array) (a:'a array) ->
 let rr = Array.fold_left ( + ) 0 table in
  if Array.length a < rr then failwith "Array of bad length in Util.array_cut." ;
  let r = Array.length table
  and accu = ref 0 in
   let b = Array.make_matrix r 0 a.(0) in
    for i = 0 to pred r do
     let shift = table.(i) in
      b.(i) <- Array.sub a !accu shift ;
      accu := !accu + shift ;
    done ;
    b ;;

(** 
array_over_cut table array
*)

let array_over_cut = fun (table:int array) (a:'a array) ->
 let t = Array.map succ table in
  array_cut t a ;;


(** 
array_guarded_over_cut thickness table array
*)

let array_guarded_over_cut = fun (e:int) (table:int array) (a:'a array) ->
 let t = Array.map succ table in
  array_guarded_cut e t a ;;


(** 
array_map2 function array1 array2
*)

let array_map2 = fun f (a:'a array) (b:'b array) ->
 let r = Array.length a in
  assert ( r = Array.length b ) ;
  let c = Array.make r ( f a.(0) b.(0) ) in
   for i = 1 to pred r do
    c.(i) <- f a.(i) b.(i)
   done ;
   c ;;


(** 
array_center_add copy addition array1 array2
The lengths of the arrays are supposed to be odd. The coefficients are added whith alignment of the center of the arrays.

Les tailles des tableaux sont supposées impaires. Les coefficients sont additionnés en alignant les centres des tableaux.*)


let array_center_add = fun copy add (a:'a array) (b:'a array) ->
 let alength = Array.length a
 and blength = Array.length b in
  let clength = max alength blength
  and ( short , long ) = if alength < blength then ( a , b ) else ( b , a )
  and shift = ( abs ( blength - alength ) ) / 2 in
   let c = Array.make clength a.(0)
   and p_c_l = pred clength in
    for i = 0 to pred shift do
     c.(i) <- copy long.(i)
    done ;
    for i = shift to p_c_l - shift do
     c.(i) <- add long.(i) short.( i - shift )
    done ;
    for i = clength - shift to p_c_l do
     c.(i) <- copy long.(i)
    done ;
    c ;;


(** 
vector_spray integer vector
*)

let vector_spray = fun (n:int) a ->
 let l = Array.length a in
  if ( l mod n != 0 ) || ( l < n ) then failwith "Problem of length in Readwrite.vector_spray." ;
  let ll = l / n in
   let lll = pred ll
   and m = Array.make_matrix n ll a.(0) in
    for i = 0 to pred n do
     let row_output = m.(i) in
      for j = 0 to lll do
       row_output.(j) <- a.( i + j * n )
      done 
    done ;
    m ;;

(** 
vector_interlace vector_array
*)

let vector_interlace = function a ->
 let n = Array.length a
 and l = Array.length a.(0) in
  let ll = n * l in
   let v = Array.make ll a.(0).(0) in
    for i = 0 to pred ll do
     v.(i) <- a.( i mod n ).( i / n )
    done ;
    v ;;

(** 
vector_to_matrix rows columns vector
*)

let vector_to_matrix = fun (r:int) (c:int) a ->
 let l = Array.length a in
  if l != r * c then failwith "Bad dimensions in Readwrite.vector_to_matrix." ; 
  let m = Array.make_matrix r c a.(0)
  and cc = pred c in
   for i = 0 to pred r do
    let row_output = m.(i)
    and ii = c * i in
     for j = 0 to cc do
      row_output.(j) <- a.( ii + j )
     done
   done ;
   m ;;











(**
§
*)

(**

Numération

 *)

(**
*)





(** 
bits_of_byte int_byte
*)

let bits_of_byte = function (x:int) ->
 let f = fun x y -> ( x land y ) <> 0 in
  Array.map ( f x ) [| 128 ; 64 ; 32 ; 16 ; 8 ; 4 ; 2 ; 1 |] ;;

(** 
int_bits_of_byte int_byte
*)

let int_bits_of_byte = function (x:int) ->
 Array.map ( function x -> if x then 1 else 0 ) ( bits_of_byte x ) ;;

(** 
reverse_int_sequence integer
*)

let reverse_int_sequence = function (n:int) ->
 let a = Array.make ( succ n ) 0 in
  for i = 0 to pred n do
   a.(i) <- n - i
  done ;
  a ;;

(** 
standard_reverse_int_sequence
*)

let standard_reverse_int_sequence = reverse_int_sequence 62 ;;

(** 
standard_reverse_binary_powers_sequence
*)

let standard_reverse_binary_powers_sequence = Array.map ( function x -> int_power x 2 ) standard_reverse_int_sequence ;;

(** 
int_sequence integer
*)

let int_sequence = function (n:int) ->
 let a = Array.make ( succ n ) 0 in
  for i = 1 to n do
   a.(i) <- i
  done ;
  a ;;

(** 
standard_int_sequence
*)

let standard_int_sequence = int_sequence 62 ;;

(** 
binary_powers_sequence integer
*)

let binary_powers_sequence = function (n:int) ->
 Array.map ( function x -> int_power x 2 ) ( int_sequence n ) ;;

(** 
standard_binary_powers_sequence
*)

let standard_binary_powers_sequence = Array.map ( function x -> int_power x 2 ) standard_int_sequence ;;

(** 
bits_of_int integer
*)

let bits_of_int = function (x:int) ->
 let f = fun x y -> ( x land y ) <> 0 in
  Array.map ( f x ) standard_reverse_binary_powers_sequence ;;


(** 
next_binary_exponent integer
This functions shifts from one unit if the integer is a power of two.

Cette fonction décale d'un cran si l'entier est une puissance de deux. *)


let next_binary_exponent = function (x:int) ->
 let b = bits_of_int ( abs x ) in
  let n = Array.length b
  and result = ref 0 in
   let i = ref 0 in
    while !i < n do
     if b.(!i) <> false then
      begin
       result := n - !i ;
       i := n ;
      end
     else
      begin
       incr i ;
      end ;
    done ;
    !result ;;

(** 
truncated_bits_of_int exponent integer
*)

let truncated_bits_of_int = fun (n:int) (x:int) ->
 let f = fun x y -> ( x land y ) <> 0
 and sequence = array_end ( 63 - n ) standard_reverse_binary_powers_sequence in
  Array.map ( f x ) sequence ;;

(** 
int_bits_of_int integer
*)

let int_bits_of_int = function (x:int) ->
 Array.map ( function x -> if x then 1 else 0 ) ( bits_of_int x ) ;;

(** 
truncated_int_bits_of_int exponent integer
*)

let truncated_int_bits_of_int = fun (n:int) (x:int) ->
 Array.map ( function x -> if x then 1 else 0 ) ( truncated_bits_of_int n x ) ;;

(** 
digits_of_int radix integer
*)

let digits_of_int = fun (p:int) (x:int) ->
 assert ( x > 0 ) ;
 let y = ref x
 and accu = ref [] in
  while !y > 0 do
   let remain = !y mod p in
    y := ( !y - remain ) / p ;
    accu := remain :: !accu ;
  done ;
  Array.of_list !accu ;;

(** 
truncated_digits_of_int radix exponent integer
*)

let truncated_digits_of_int = fun (p:int) (n:int) (x:int) ->
 assert ( x >= 0 ) ;
 let y = ref x
 and i = ref ( pred n )
 and accu = Array.make n 0 in
  begin
   try
    while !y > 0 do
     let remain = !y mod p in
      y := ( !y - remain ) / p ;
      accu.(!i) <- remain ;
      decr i ;
    done
   with _ ->
    ()
  end ;
  accu ;;


(** 
naive_reverse_int_of_bits bool_bits
*)

let naive_reverse_int_of_bits = function (a:bool array) ->
 let b = Array.mapi ( fun i x -> if x then int_power i 2 else 0 ) a in
  Array.fold_left ( + ) 0 b ;;

(** 
reverse_int_of_bits bool_bits
*)

let reverse_int_of_bits = function (a:bool array) ->
 naive_reverse_int_of_bits a ;;


(** 
naive_int_of_bits bool_bits
*)

let naive_int_of_bits = function (a:bool array) ->
 let b = reverse_array a in
  reverse_int_of_bits b ;;

(** 
other_int_of_bits bool_bits
*)

let other_int_of_bits = function (a:bool array) ->
 let accu = ref 0
 and n = pred ( Array.length a ) in
  let sequence = array_end ( 62 - n ) standard_reverse_binary_powers_sequence in
   for i = 0 to n do
    if a.(i) then
     accu := !accu + sequence.(i) ;
   done ;
   !accu ;;

(** 
int_of_bits bool_bits
*)

let int_of_bits = function (a:bool array) ->
 let accu = ref 0
 and n = pred ( Array.length a ) in
  for i = 0 to pred n do
   if a.(i) then
    incr accu ;
   accu := 2 * !accu ;
  done ;
  if a.(n) then
   incr accu ;
  !accu ;;


(** 
int_of_digits radix integer
*)

let int_of_digits = fun (p:int) (a:int array) ->
 let n = pred ( Array.length a )
 and accu = ref 0 in
  for i = 0 to pred n do
   let digit = a.(i) in
    if digit > 0 then
     accu := !accu + digit ;
    accu := p * !accu ;
  done ;
  let digit = a.(n) in
   if digit > 0 then
    accu := !accu + digit ;
   !accu ;;


(** 
bit_reversal integer
*)

let bit_reversal = function (x:int) ->
 let a = bits_of_int x in
  let b = reverse_array a in 
   int_of_bits b ;;

(** 
truncated_bit_reversal exponent integer
*)

let truncated_bit_reversal = fun (n:int) (x:int) ->
 let a = truncated_bits_of_int n x in
  let b = reverse_array a in
   int_of_bits b ;;

(** 
digit_reversal radix integer
*)

let digit_reversal = fun (p:int) (x:int) ->
 let a = digits_of_int p x in
  let b = reverse_array a in 
   int_of_digits p b ;;

(** 
truncated_digit_reversal radix exponent integer
*)

let truncated_digit_reversal = fun (p:int) (n:int) (x:int) ->
 let a = truncated_digits_of_int p n x in
  let b = reverse_array a in 
   int_of_digits p b ;;












(**
§ § §
*)


end ;;




module Bary = struct





(**
§
*)

(**

Introduction

 *)

(**
*)





(** The mathematician will find in this module tools to treat weighted sets, inspired from those of the module Set of the OCaml standard library, with the difference that the sets are preferably modified in place.

Conventions

An element disappears when its weight is zero.

The functions of this module are not sealed.

The sets are modifiable in place.

The cardinal is recorded and modified with the set.

Comments

This module is distributed under the same licence as Ocaml.

§

La mathématicienne ou le mathématicien trouvera dans ce module des outils pour traiter les ensembles à poids, inspirés de ceux du module Set de la bibliothèque standard OCaml, à la différence près que les ensembles sont de préférence modifiés en place.

Conventions

Un élément disparaît quand son poids est nul.

Les fonctions de ce module ne sont pas étanches.

Les ensembles sont modifiables en place.

Le cardinal est enregistré et modifié avec l'ensemble.

Commentaires

Ce module est distribué selon la même licence qu'Ocaml.

Copyright Stéphane Grognet
Laboratoire de mathématiques Jean Leray UMR 6629 CNRS
Fédération de recherche mathématique des Pays de la Loire
Centre Henri Lebesgue
IREM des Pays de la Loire - Université de Nantes
version 0.1
*)

(** @version 0.1 *)

(** @author Stéphane Grognet *)

(** @since 2013 *)





open Util ;;


module type Index_type = sig

type t
val zero: unit -> t
val compare: t -> t -> int
val copy: t -> t

end ;;


module type Weight_type = sig

type t
val zero: unit -> t
val eq_zero: t -> bool
val compare: t -> t -> int
val copy: t -> t
val add: t -> t -> t
val sub: t -> t -> t
val opp: t -> t

end ;;


module Make (Index: Index_type) (Weight: Weight_type) = struct




(**
§
*)

(**

Introduction

 *)

(**
*)





(** This functor deals with weighted sets.

Ce foncteur traite des ensembles à poids. *)






(**
§
*)

(**

Modules auxiliaires

Auxiliary modules

 *)

(**
*)





module Pairs = struct

type t = Index.t * Weight.t ;;
let compare = fun (( x , xx ):t) (( y , yy ):t) ->
 Index.compare x y ;;

end ;;


module StrongPairs = struct

type t = Index.t * Weight.t ;;
let compare = fun (( x , xx ):t) (( y , yy ):t) ->
 let c = Index.compare x y in
  if c = 0 then
   Weight.compare xx yy
  else c ;;

end ;;


(** The type elt consists in couples (index, weight) and is identified with the type elt of the following modules E and S.

Le type elt est formé par couple (indice, poids) et est identifié avec le type elt des modules E et S suivants. *)



type index = Index.t ;;

type weight = Weight.t ;;

type elt = index * weight ;;


(** The module E provides basic tools from the module Set of the standard OCaml library.

Le module E fournit les outils de base à partir du module Set de la bibliothèque standard OCaml. *)



module E = ( Set.Make (Pairs)
: sig
 include module type of Set.Make (Pairs)
end
 with type elt := elt ) ;;


(** In contrast to the module E, the module S takes the weights into account in order to build some functions.

À la différence du module E, le module S tient compte des poids pour construire quelques fonctions. *)



module S = ( Set.Make (StrongPairs)
: sig
 include module type of Set.Make (StrongPairs)
end
 with type elt := elt ) ;;




(**
§
*)

(**

Construction of the functor

Construction du foncteur

 *)

(**
*)





(** The type t records a set modifiable in place and its cardinal.

Le type t enregistre un ensemble modifiable en place et son cardinal.*)


type t = { mutable cardinal: int ; mutable content: E.t } ;;




(**
§
*)

(**

Importations

 *)

(**
*)





(** 
empty unit
*)

let empty = function () ->
 { cardinal = 0 ; content = E.empty } ;;

(** 
is_empty set
*)

let is_empty = function (s:t) ->
 E.is_empty s.content ;;

(** 
quick_is_empty set
*)

let quick_is_empty = function (s:t) ->
 s.cardinal = 0 ;;

(** 
mem element set
*)

let mem = fun (x:elt) (s:t) ->
 E.mem x s.content ;;

(** 
element_copy element
*)

let element_copy = function ((x , y):elt) ->
 ( Index.copy x , Weight.copy y ) ;;

(** 
singleton element
*)

let singleton = function (x:elt) ->
 { cardinal = 1 ; content = E.singleton x } ;;

(** 
remove element set
*)

let remove = fun (x:elt) (s:t) ->
 if E.mem x s.content then
  begin
   s.cardinal <- pred s.cardinal ;
   s.content <- E.remove x s.content
  end ;;

(** 
iter function set
*)

let iter = fun f (s:t) ->
 E.iter f s.content ;
 s.cardinal <- E.cardinal s.content ;;

(** 
fold function set init
*)

let fold = fun f (s:t) init ->
 E.fold f s.content init ;;

(** 
for_all predicate set
*)

let for_all = fun (p:elt -> bool) (s:t) ->
 E.for_all p s.content ;;

(** 
exists predicate set
*)

let exists = fun (p:elt -> bool) (s:t) ->
 E.exists p s.content ;;

(** 
filter predicate set
*)

let filter = fun (p:elt -> bool) (s:t) ->
 let t = E.filter p s.content in
  { cardinal = E.cardinal t ; content = t } ;;

(** 
partition predicate set
*)

let partition = fun (p:elt -> bool) (s:t) ->
 let ( yes , no ) = E.partition p s.content in
  let c = E.cardinal yes
  and cc = E.cardinal no in
   ( { cardinal = c ; content = yes } , { cardinal = cc ; content = no } )

(** 
cardinal set
*)

let cardinal = function (s:t) ->
 s.cardinal ;;

(** 
elements set
*)

let elements = function (s:t) ->
 ( s.cardinal , E.elements s.content ) ;;

(** 
to_list set
*)

let to_list = function (s:t) ->
 List.fast_sort Pairs.compare ( E.elements s.content ) ;;

(** 
min_elt set
*)

let min_elt = function (s:t) ->
 E.min_elt s.content ;;

(** 
max_elt set
*)

let max_elt = function (s:t) ->
 E.max_elt s.content ;;

(** 
choose set
*)

let choose = function (s:t) ->
 E.choose s.content ;;

(** 
split element set
*)

let split = fun (x:elt) (s:t) ->
 E.split x s.content ;;


(** 
translate set
This function helps to use the module S.

Cette fonction sert à utiliser le module S. *)


let translate = function (s:t) ->
 List.fold_right S.add ( E.elements s.content ) S.empty ;;

(** 
compare set1 set2
*)

let compare = fun (s1:t) (s2:t) ->
 S.compare ( translate s1 ) ( translate s2 ) ;;

(** 
equal set1 set2
*)

let equal = fun (s1:t) (s2:t) ->
 S.equal ( translate s1 ) ( translate s2 ) ;;

(** 
subset set1 set2
*)

let subset = fun (s1:t) (s2:t) ->
 S.subset ( translate s1 ) ( translate s2 ) ;;

(** 
strong_mem element set
*)

let strong_mem = fun (x:elt) (s:t) ->
 S.mem x ( translate s ) ;;




(**
§
*)

(**

Constructions propres aux ensembles à poids

Constructions proper to weighted sets

 *)

(**
*)





(** 
add element set
*)

let add = fun (( x , xx ) as z:elt) (s:t) ->
 let c = s.cardinal
 and d = s.content in
  if E.mem z s.content then
   begin
    let f = E.filter ( function w -> Pairs.compare z w = 0 ) d
    and t = E.remove z d in
     let liste = E.elements f in
      assert ( List.length ( List.tl liste ) = 0 ) ;
      let ( y , yy ) = List.hd liste in
       let w = Weight.add xx yy in
        if Weight.eq_zero w then
         begin
          s.cardinal <- pred c ;
          s.content <- t ;
         end
        else
         s.content <- E.add ( x , w ) t ;
   end
  else
   begin
    s.cardinal <- succ c ;
    s.content <- E.add z d ;
   end ;;

(** 
sub element set
*)

let sub = fun (( x , xx ) as z:elt) (s:t) ->
 let e = s.content
 and c = s.cardinal in
  if E.mem z e then
   begin
    let f = E.filter ( function w -> Pairs.compare z w = 0 ) e
    and t = E.remove z e in
     let liste = E.elements f in
      assert ( List.length ( List.tl liste ) = 0 ) ;
      let ( y , yy ) = List.hd liste in
       let w = Weight.sub yy xx in
        if Weight.eq_zero w then
         begin
          s.cardinal <- pred c ;
          s.content <- t ;
         end
        else
         s.content <- E.add ( x , w ) t ;
   end
  else
   begin
    s.cardinal <- succ c ;
    s.content <- E.add ( x , Weight.opp xx ) e ;
   end ;;


(** 
inter set1 set2
The intersection chooses the minimal weight.

L'intersection choisit le poids minimal. *)


let rec inter = fun (s1:t) (s2:t) ->
 let c1 = s1.cardinal
 and d1 = s1.content
 and d = ref E.empty
 and c = ref 0
 and c2 = s2.cardinal
 and d2 = s2.content in
  if c1 <= c2 then
   begin
    let liste = ref ( E.elements d1 ) in
     let count = ref c1 in
      while !count > 0 do
       let z = List.hd !liste in
        if E.mem z d2 then
         begin
          let e = E.elements ( E.filter ( function w -> Pairs.compare z w = 0 ) d2 )
          and x = fst z
          and xx = snd z in
           assert ( List.length ( List.tl e ) = 0 ) ;
           let ( y , yy ) = List.hd e in
            let zz = if Weight.compare xx yy <= 0 then xx else yy in
             d := E.add ( x , zz ) !d ;
             incr c ;
         end ;
         liste := List.tl !liste ;
         decr count ;
      done ;
      { cardinal = !c ; content = !d }
   end
  else
   inter s2 s1 ;;

(** 
of_list element_list
*)

let of_list = function (x:elt list) ->
 let s = empty () in
  let f = function y -> add y s in
   List.iter f x ;
   s ;;

(** 
map function set
*)

let map = fun (f:elt -> elt) (s:t) ->
 let g = fun x u -> E.add ( f x ) u in
  let d = E.fold g s.content E.empty in
   { cardinal = E.cardinal d ; content = d } ;;

(** 
copy set
*)

let copy = function (s:t) ->
 let g = fun x u -> E.add ( element_copy x ) u in
  let d = E.fold g s.content E.empty in
   { cardinal = s.cardinal ; content = d } ;;


(** 
opp set
*)

let opp = function (s:t) ->
 let f = function ( x , y ) -> ( x , Weight.opp y ) in
  let g = fun x u -> E.add ( f x ) u in
   let d = E.fold g s.content E.empty in
    { cardinal = s.cardinal ; content = d } ;;

(** 
union set1 set2
*)

let union = fun (s1:t) (s2:t) ->
 let s = empty () in
  let f = function y -> add y s in
   E.iter f s1.content ;
   E.iter f s2.content ;
   s ;;

(** 
diff set1 set2
*)

let diff = fun (s1:t) (s2:t) ->
 let s = empty () in
  let f = function y -> add y s
  and g = function y -> sub y s in
   E.iter f s1.content ;
   E.iter g s2.content ;
   s ;;

(** 
extract index set
*)

let extract = fun (i:Index.t) (s:t) ->
 let test = mem ( i , Weight.zero () ) s in
  if test then
   begin
    let p = function ( j , y ) -> Index.compare i j = 0 in
     let ( with_i , without_i ) = partition p s in
      E.choose with_i.content
   end
  else
   failwith "Index not present in Bary.Make.extract." ;;





(**
§ § §
*)




end ;;



module Z = struct

type t = int ;;
let zero = function () -> 0 ;;
let compare = Pervasives.compare ;;
let copy = Util.int_identity ;;
let eq_zero = function (x:t) -> x = 0 ;;
let add = ( + ) ;;
let sub = ( - ) ;;
let opp = ( ~- ) ;;

end ;;



module Zset = struct


include Make (Z) (Z) ;;
let insert_add = add ;;
let insert_sub = sub ;;
type u = t ;;
type v = t ;;
let norm = map ( function ( x , y ) -> ( x , abs y ) ) ;;
let norm_inject = map ( function ( x , y ) -> ( x , y ) ) ;;
let zero = empty ;;
let to_string = function (x:t) ->
 begin
  let f = function ( x , y ) -> ( string_of_int x ) ^ "^" ^ ( string_of_int y ) in
   String.concat "~" ( List.rev ( List.rev_map f ( snd ( elements x ) ) ) )
 end ;;
let of_string = function (s:string) ->
 begin
  let listing = Str.split ( Str.regexp_string "~" ) s
  and result = empty () in
   let f = function (st:string) ->
    begin
     let listing = Str.split ( Str.regexp_string "^" ) st in
      add ( int_of_string ( List.hd listing ) , int_of_string ( List.hd ( List.tl listing ) ) ) result
    end in
    ignore ( List.rev_map f listing ) ;
    result
 end ;;
let print = function (x:t) -> print_string ( to_string x ) ;;
let eq = equal ;;
let eq_zero = function (x:t) -> x.cardinal = 0 ;;
let int_mult = fun (n:int) (x:t) ->
 begin
  let f = function ( a , b ) -> ( a , n * b ) in
   map f x
 end ;;
let int_pow = fun (n:int) (x:t) ->
 begin
  let f = function ( a , b ) -> ( a , Util.int_power n b ) in
   map f x
 end ;;
let add = union ;;
let sub = diff ;;
let mult = add ;;

end ;;



(**
§ § §
*)




end ;;





module Deg = struct




(**
§
*)

(**

Introduction

 *)

(**
*)





(** The mathematician will find in this module utility functions and types to treat big degrees and valuations of polynomials and polynomial fractions. The infinite values are provided by the real numbers.

Conventions

When of type float, the absolute value of degrees must not be greater than or equal to a value which is the minimum of the inverse of epsilon_float and of max_int.

The addition and substraction and multiplication pass quickly enough into big integers in order to avoid casual overflows.

This module is distributed under the same licence as Ocaml.

§

La mathématicienne ou le mathématicien trouvera dans ce module des fonctions utilitaires et types pour traiter les grands degrés et valuations des polynômes et fractions ratonnelles. Les infinis sont fournis par les réels.

Conventions

Pour les degrés de type float, la valeur absolue ne doit pas atteindre ou dépasser une valeur qui est le minimum de l'inverse de epsilon_float et de max_int.

Les addition, soustraction et multiplication passent assez rapidement dans les grands entiers pour éviter d'éventuels dépassements de capacité.

Ce module est distribué selon la même licence qu'Ocaml.

Copyright Stéphane Grognet
Laboratoire de mathématiques Jean Leray UMR 6629 CNRS
Fédération de recherche mathématique des Pays de la Loire
IREM des Pays de la Loire - Université de Nantes
version 0.1
*)

(** @version 0.1 *)

(** @author Stéphane Grognet *)

(** @since février 2012 *)




(** 
bad_float real
*)

let bad_float = function (x:float) ->
 let xx = abs_float x
 and result = ref false in
  if ( xx >= 1. /. epsilon_float ) || ( int_of_float xx < 0 ) || ( int_of_float xx >= max_int ) || ( xx >= float max_int ) then
   result := true ;
  if ( Pervasives.compare x infinity = 0 ) || ( Pervasives.compare x neg_infinity = 0 ) then
   result := false ;
  !result ;;


(** The type collects integer and big integer and real values. The real numbers provide the infinities.

Le type collationne les valeurs entières, grandes entières, réelles. Les réels fournissent les infinis. *)


type t = 
 | Witness
 | Float of float
 | Int of int
 | Big of Big_int.big_int ;;

let zero = Int 0 ;;

let witness = Witness ;;

(** 
float_demakeup degree
*)

let float_demakeup = function (x:t) ->
 match x with
 | Float u ->
  begin
   if bad_float u then failwith "Bad real in Deg.float_demakeup." ;
   u
  end
 | _ -> failwith "Not a Float in Deg.float_demakeup." ;;

(** 
int_demakeup degree
*)

let int_demakeup = function (x:t) ->
 match x with
 | Int u -> u
 | _ -> failwith "Not an Int in Deg.int_demakeup." ;;

(** 
big_demakeup degree
*)

let big_demakeup = function (x:t) ->
 match x with
 | Big u -> u
 | _ -> failwith "Not a Big in Deg.float_demakeup." ;;

(** 
print degree
*)

let print = function (x:t) ->
 match x with
 | Witness -> print_string "Deg.Witness"
 | Float u -> print_float u
 | Int u -> print_int u
 | Big u -> print_string ( Big_int.string_of_big_int u ) ;;

(** 
eq_zero degree
*)

let eq_zero = function (x:t) ->
 match x with
 | Witness -> false
 | Float u -> ( Pervasives.compare u 0. ) = 0
 | Int u -> ( Pervasives.compare u 0 ) = 0
 | Big u -> ( Big_int.compare_big_int u Big_int.zero_big_int ) = 0 ;;

(** 
copy degree
*)

let copy = function (x:t) ->
 match x with
 | Witness -> Witness
 | Float u -> Float ( u +. 0. )
 | Int u -> Int u
 | Big u -> Big ( Big_int.add_big_int u Big_int.zero_big_int ) ;;

(** 
opp degree
*)

let opp = function (x:t) ->
 match x with
 | Witness -> Witness
 | Float u ->
  begin
   if bad_float u then failwith "Bad real in Deg.opp." ;
   Float ( -. u )
  end
 | Int u -> Int ( - u )
 | Big u -> Big ( Big_int.minus_big_int u ) ;;

(** 
to_int degree
*)

let to_int = function (x:t) ->
 match x with
 | Witness -> failwith "Witness in Deg.to_int."
 | Float u -> int_of_float u
 | Int u -> u
 | Big u -> Big_int.int_of_big_int u ;;

(** 
from_int integer
*)

let from_int = function (u:int) ->
 Int u ;;

(** 
pred degree
*)

let pred = function (x:t) ->
 match x with
 | Witness -> Witness
 | Float u -> Float ( u -. 1. )
 | Int u -> Int ( pred u )
 | Big u -> Big ( Big_int.pred_big_int u ) ;;

(** 
succ degree
*)

let succ = function (x:t) ->
 match x with
 | Witness -> Witness
 | Float u -> Float ( u +. 1. )
 | Int u -> Int ( succ u )
 | Big u -> Big ( Big_int.succ_big_int u ) ;;

(** 
maximum degree1 degree2
*)

let rec maximum = fun (x:t) (y:t) ->
 match x with
 | Witness -> y
 | Float u ->
  begin
   if bad_float u then failwith "Bad real in Deg.maximum." ;
   match ( Pervasives.compare u infinity , Pervasives.compare u neg_infinity ) with
   | ( 0 , _ ) -> x
   | ( _ , 0 )  -> y
   | _ ->
    begin
     match y with
     | Witness -> x
     | Float v ->
      begin
       if bad_float v then failwith "Bad real in Deg.maximum." ;
       Float ( max u v )
      end
     | _ -> maximum y ( Int ( int_of_float u ) )
    end
  end
 | Int u ->
  begin
   match y with
   | Witness -> x
   | Float v ->
    begin
     if bad_float v then failwith "Bad real in Deg.maximum." ;
     match ( Pervasives.compare v infinity , Pervasives.compare v neg_infinity ) with
     | ( 0 , _ ) -> y
     | ( _ , 0 )  -> x
     | _ -> Int ( max u ( int_of_float v ) )
    end
   | Int v -> Int ( max u v )
   | Big v -> Big ( Big_int.max_big_int v ( Big_int.big_int_of_int u ) )
  end
 | Big u ->
  begin
   match y with
   | Witness -> x
   | Float v ->
    begin
     if bad_float v then failwith "Bad real in Deg.maximum." ;
     match ( Pervasives.compare v infinity , Pervasives.compare v neg_infinity ) with
     | ( 0 , _ ) -> y
     | ( _ , 0 )  -> x
     | _ -> maximum x ( Int ( int_of_float v ) )
    end
   | Int v -> maximum y x
   | Big v -> Big ( Big_int.max_big_int u v )
  end ;;

(** 
minimum degree1 degree2
*)

let minimum = fun (x:t) (y:t) ->
 opp ( maximum ( opp x ) ( opp y ) ) ;;

(** 
add degree1 degree2
*)

let rec add = fun (x:t) (y:t) ->
 match x with
 | Witness -> failwith "Witness adding in Deg.add."
 | Float u ->
  begin
   if bad_float u then failwith "Bad real in Deg.add." ;
   match ( Pervasives.compare u infinity , Pervasives.compare u neg_infinity ) with
   | ( 0 , _ ) ->
    begin
     match y with
     | Witness -> failwith "Witness adding in Deg.add."
     | Float v ->
      begin
       if bad_float v then failwith "Bad real in Deg.add." ;
       if Pervasives.compare v neg_infinity = 0 then failwith "Undetermined form in Deg.add."
       else x
      end
     | _ -> x
    end
   | ( _ , 0 )  ->
    begin
     match y with
     | Witness -> failwith "Witness adding in Deg.add."
     | Float v ->
      begin
       if bad_float v then failwith "Bad real in Deg.add." ;
       if Pervasives.compare v infinity = 0 then failwith "Undetermined form in Deg.add."
       else x
      end
     | _ -> x
    end
   | _ ->
    begin
     match y with
     | Witness -> failwith "Witness adding in Deg.add."
     | Float v ->
      begin
       if bad_float v then failwith "Bad real in Deg.add." ;
       Int ( ( int_of_float u ) + ( int_of_float v ) )
      end
     | _ -> add y ( Int ( int_of_float u ) )
    end
  end
 | Int u ->
  begin
   match y with
   | Witness -> failwith "Witness adding in Deg.add."
   | Float v ->
    begin
     if bad_float v then failwith "Bad real in Deg.add." ;
     match ( Pervasives.compare v infinity , Pervasives.compare v neg_infinity ) with
     | ( 0 , _ ) -> y
     | ( _ , 0 )  -> y
     | _ -> add x ( Int ( int_of_float v ) )
    end
   | Int v -> Big ( Big_int.add_big_int ( Big_int.big_int_of_int u ) ( Big_int.big_int_of_int v ) )
   | Big v -> Big ( Big_int.add_big_int v ( Big_int.big_int_of_int u ) )
  end
 | Big u ->
  begin
   match y with
   | Witness -> failwith "Witness adding in Deg.add."
   | Float v ->
    begin
     if bad_float v then failwith "Bad real in Deg.add." ;
     match ( Pervasives.compare v infinity , Pervasives.compare v neg_infinity ) with
     | ( 0 , _ ) -> y
     | ( _ , 0 )  -> y
     | _ -> add x ( Int ( int_of_float v ) )
    end
   | Int v -> add y x
   | Big v -> Big ( Big_int.add_big_int u v )
  end ;;

(** 
sub degree1 degree2
*)

let sub = fun (x:t) (y:t) ->
 match x with
 | Witness -> failwith "Witness substracting in Deg.sub."
 | Float u ->
  begin
   if bad_float u then failwith "Bad real in Deg.sub." ;
   match y with
   | Witness -> failwith "Witness substracting in Deg.sub."
   | Float v ->
    begin
     if bad_float v then failwith "Bad real in Deg.sub." ;
     add x ( opp y )
    end
   | _ -> add x ( opp y )
  end
 | _ ->
  begin
   match y with
   | Witness -> failwith "Witness substracting in Deg.sub."
   | Float v ->
    begin
     if bad_float v then failwith "Bad real in Deg.sub." ;
     add x ( opp y )
    end
   | _ -> add x ( opp y )
  end ;;

(** 
shift integer degree
*)

let shift = fun (i:int) (x:t) ->
 add ( Int i ) x ;;

(** 
mult degree1 degree2
*)

let rec mult = fun (x:t) (y:t) ->
 match x with
 | Witness -> failwith "Witness multiplying in Deg.sub."
 | Float u ->
  begin
   if bad_float u then failwith "Bad real in Deg.mult." ;
   match ( Pervasives.compare u infinity , Pervasives.compare u neg_infinity ) with
   | ( 0 , _ ) ->
    begin
     match y with
     | Witness -> failwith "Witness multiplying in Deg.sub."
     | Float v ->
      begin
       if bad_float v then failwith "Bad real in Deg.mult." ;
       if v = 0. then failwith "Undetermined form in Deg.mult." ;
       match ( Pervasives.compare v infinity , Pervasives.compare v neg_infinity ) with
       | ( 0 , _ ) -> x
       | ( _ , 0 )  -> y
       | _ ->
        begin
         if v > 0. then x
         else opp x
        end
      end
     | Int v ->
      begin
       match Pervasives.compare v 0 with
       | 0 -> failwith "Undetermined form in Deg.mult." ;
       | 1 -> x
       | _ -> opp x
      end
     | Big v ->
      begin
       match Pervasives.compare v Big_int.zero_big_int with
       | 0 -> failwith "Undetermined form in Deg.mult." ;
       | 1 -> x
       | _ -> opp x
      end
    end
   | ( _ , 0 )  -> opp ( mult ( opp x ) y )
   | _ -> mult ( Big ( Big_int.big_int_of_int ( int_of_float u ) ) ) y
  end
 | Int u ->
  begin
   match y with
   | Witness -> failwith "Witness multiplying in Deg.sub."
   | Float v ->
    begin
     if bad_float v then failwith "Bad real in Deg.mult." ;
     match ( Pervasives.compare v infinity , Pervasives.compare v neg_infinity ) with
     | ( 0 , _ ) ->
      begin
       match Pervasives.compare u 0 with
       | 0 -> failwith "Undetermined form in Deg.mult." ;
       | 1 -> y
       | _ -> opp y
      end
     | ( _ , 0 )  -> opp ( mult x ( opp y ) )
     | _ -> Big ( Big_int.mult_big_int ( Big_int.big_int_of_int u ) ( Big_int.big_int_of_int ( int_of_float v ) ) )
    end
   | Int v -> Big ( Big_int.mult_big_int ( Big_int.big_int_of_int u ) ( Big_int.big_int_of_int v ) )
   | Big v -> Big ( Big_int.mult_big_int v ( Big_int.big_int_of_int u ) )
  end
 | Big u ->
  begin
   match y with
   | Witness -> failwith "Witness multiplying in Deg.sub."
   | Float v ->
    begin
     if bad_float v then failwith "Bad real in Deg.mult." ;
     match ( Pervasives.compare v infinity , Pervasives.compare v neg_infinity ) with
     | ( 0 , _ ) ->
      begin
       match Pervasives.compare u Big_int.zero_big_int with
       | 0 -> failwith "Undetermined form in Deg.mult." ;
       | 1 -> y
       | _ -> opp y
      end
     | ( _ , 0 )  -> opp ( mult x ( opp y ) )
     | _ -> Big ( Big_int.mult_big_int u ( Big_int.big_int_of_int ( int_of_float v ) ) )
    end
   | Int v -> mult y x
   | Big v -> Big ( Big_int.mult_big_int u v )
  end ;;


(** 
compare degree1 degree2
*)

let rec compare = fun (x:t) (y:t) ->
 match x with
 | Witness ->
  begin
   match y with
   | Witness -> 0
   | _ -> - 1
  end
 | Float u ->
  begin
   if bad_float u then failwith "Bad real in Deg.compare." ;
   match ( Pervasives.compare u infinity , Pervasives.compare u neg_infinity ) with
   | ( 0 , _ ) ->
    begin
     try ( let v = float_demakeup y in ignore ( bad_float v ) ; Pervasives.compare u v )
     with Failure "Not a Float in Deg.float_demakeup." -> 1
    end
   | ( _ , 0 )  ->
    begin
     try ( let v = float_demakeup y in ignore ( bad_float v ) ; Pervasives.compare u v )
     with Failure "Not a Float in Deg.float_demakeup." -> -1
    end
   | _ ->
    begin
     match y with
     | Witness -> 1
     | Float v ->
      begin
       if bad_float v then failwith "Bad real in Deg.compare." ;
       Pervasives.compare u v
      end
     | _ -> compare ( Int ( int_of_float u ) ) y
    end
  end
 | Int u ->
  begin
   match y with
   | Witness -> 1
   | Float v ->
    begin
     if bad_float v then failwith "Bad real in Deg.compare." ;
     match ( Pervasives.compare v infinity , Pervasives.compare v neg_infinity ) with
     | ( 0 , _ ) -> -1
     | ( _ , 0 )  -> 1
     | _ -> Pervasives.compare u ( int_of_float v )
    end
   | Int v -> Pervasives.compare u v
   | Big v -> Big_int.compare_big_int ( Big_int.big_int_of_int u ) v
  end
 | Big u ->
  begin
   match y with
   | Witness -> 1
   | Float v ->
    begin
     if bad_float v then failwith "Bad real in Deg.compare." ;
     match ( Pervasives.compare v infinity , Pervasives.compare v neg_infinity ) with
     | ( 0 , _ ) -> -1
     | ( _ , 0 )  -> 1
     | _ -> - ( compare ( Int ( int_of_float v ) ) x )
    end
   | Int v -> - ( compare y x )
   | Big v -> Big_int.compare_big_int u v
  end ;;





(**
§ § §
*)





end










module Data = struct




(**
§
*)

(**

Introduction

 *)

(**
*)





(** The mathematician will find in this module:

  1. algebraic structures to use in the modules sparse_vector.ml, sparse_tensor.ml, sparse_matrix.ml, mat.ml, fft.ml either as indices or as coefficients,
  2. constants used in the module sci.ml,
  3. constants usable with it; in that case only the character string are provided. There is only to convert them into the type Num.num as in the examples of the section , paying attention to the decimal dot and to the length of the character strings. Afterwards the function Sci.sci_of_num provides the conversion into the complex numbers in scientific notation with big mantissa.

Comments

A functor Index_of_array is provided in order to transform any family of indices gathered in an array and equipped with some utility functions into an acceptable index module.

This module is distributed under the same licence as Ocaml.

§

La mathématicienne ou le mathématicien trouvera dans ce module :

  1. des structures algébriques à utiliser dans les modules sparse_vector.ml, sparse_tensor.ml, sparse_matrix.ml, mat.ml, fft.ml comme indices ou coefficients,
  2. des constantes utilisées dans le module sci.ml,
  3. des constantes utilisables avec celui-ci ; dans ce cas seules les chaînes de caractères sont fournies. Il suffit de les convertir vers le type Num.num comme dans dans les exemples de la section , en faisant attention au point décimal et à la longueur des chaînes de caractères. Ensuite la fonction Sci.sci_of_num assure la conversion vers les nombres complexes en notation scientifique à grande mantisse.

Commentaires

Un foncteur Index_of_array est fourni pour transformer une famille d'indices rassemblée dans un tableau et munie de quelques fonctions utilitaires en un module d'indices acceptable.

Ce module est distribué selon la même licence qu'Ocaml.

Copyright Stéphane Grognet
Laboratoire de mathématiques Jean Leray UMR 6629 CNRS
Fédération de recherche mathématique des Pays de la Loire
IREM des Pays de la Loire - Université de Nantes
version 0.2
*)

(** @version 0.2 *)

(** @author Stéphane Grognet *)

(** @since 2012, 2013 *)





(**
§
*)

(**

Types de modules divers

Miscellaneous module types

 *)

(**
*)





open Util ;;


module type Norm_type = sig
 type t
 type v
 val norm_inject: t -> v
 val zero: unit -> t
 val of_string: string -> t
 val to_string: t -> string
 val print: t -> unit
 val eq: t -> t -> bool
 val eq_zero: t -> bool
 val compare: t -> t -> int
 val add: t -> t -> t
 val int_mult: int -> t -> t
 val mult: t -> t -> t
 val square: t -> t
end ;;




module type Bare_rng_coeff_type = sig
(** The rng is supposed to be commutative.

L'annau est supposé commutatif. *)



 type t
 type u
 val zero: unit -> t
 val of_string: string -> t
 val to_string: t -> string
 val print: t -> unit
 val copy: t -> t
 val eq_zero: t -> bool
 val eq: t -> t -> bool

(** The comparison is used only for extremums seeks and infinity norms.

La comparaison n'est utilisée que pour les recherches d'extremums et les normes infinies. *)


 val compare: t -> t -> int
 val norm: t -> u
 val opp: t -> t
 val add: t -> t -> t
 val sub: t -> t -> t
 val int_mult: int -> t -> t
 val mult: t -> t -> t
 val square: t -> t
 val int_pow: int -> t -> t
end ;;




module type Bare_field_coeff_type = sig
(** A field is commutative.

Le corps est supposé commutatif. *)



 type t
 type u
 val zero: unit -> t
 val one: unit -> t
 val of_string: string -> t
 val to_string: t -> string
 val print: t -> unit
 val copy: t -> t
 val eq_zero: t -> bool
 val eq_one: t -> bool
 val eq: t -> t -> bool

(** The comparison is used only for extremums seeks and infinity norms.

La comparaison n'est utilisée que pour les recherches d'extremums et les normes infinies. *)


 val compare: t -> t -> int
 val norm: t -> u
 val opp: t -> t
 val add: t -> t -> t
 val sub: t -> t -> t
 val int_mult: int -> t -> t
 val mult: t -> t -> t
 val square: t -> t
 val inv: t -> t
 val div: t -> t -> t
 val int_div: int -> t -> t
 val int_pow: int -> t -> t
end ;;



module Normalize_rng_coefficient (C:Bare_rng_coeff_type) (N:Norm_type with type v = C.t) = struct
 type t = C.t ;;
 type u = N.t ;;
 let norm_inject = N.norm_inject ;;
 let zero = C.zero ;;
 let of_string = C.of_string ;;
 let to_string = C.to_string ;;
 let print = C.print ;;
 let copy = C.copy ;;
 let eq_zero = C.eq_zero ;;
 let eq = C.eq ;;
 let compare = C.compare ;;
 let norm_zero = N.zero ;;
 let norm = C.norm ;;
 let norm_of_string = N.of_string ;;
 let norm_to_string = N.to_string ;;
 let norm_print = N.print ;;
 let norm_eq = N.eq ;;
 let norm_eq_zero = N.eq_zero ;;
 let norm_compare = N.compare ;;
 let norm_add = N.add ;;
 let norm_int_mult = N.int_mult ;;
 let norm_mult = N.mult ;;
 let norm_square = N.square ;;
 let opp = C.opp ;;
 let add = C.add ;;
 let sub = C.sub ;;
 let int_mult = C.int_mult ;;
 let mult = C.mult ;;
 let square = C.square ;;
 let int_pow = C.int_pow ;;
end ;;




module Normalize_field_coefficient (C:Bare_field_coeff_type) (N:Norm_type with type v = C.t) = struct
 type t = C.t ;;
 type u = N.t ;;
 let norm_inject = N.norm_inject ;;
 let zero = C.zero ;;
 let one = C.one ;;
 let of_string = C.of_string ;;
 let to_string = C.to_string ;;
 let print = C.print ;;
 let copy = C.copy ;;
 let eq_zero = C.eq_zero ;;
 let eq_one = C.eq_one ;;
 let eq = C.eq ;;
 let compare = C.compare ;;
 let norm_zero = N.zero ;;
 let norm = C.norm ;;
 let norm_of_string = N.of_string ;;
 let norm_to_string = N.to_string ;;
 let norm_print = N.print ;;
 let norm_eq = N.eq ;;
 let norm_eq_zero = N.eq_zero ;;
 let norm_compare = N.compare ;;
 let norm_add = N.add ;;
 let norm_int_mult = N.int_mult ;;
 let norm_mult = N.mult ;;
 let norm_square = N.square ;;
 let opp = C.opp ;;
 let add = C.add ;;
 let sub = C.sub ;;
 let int_mult = C.int_mult ;;
 let mult = C.mult ;;
 let square = C.square ;;
 let inv = C.inv ;;
 let div = C.div ;;
 let int_div = C.int_div ;;
 let int_pow = C.int_pow ;;
end ;;




module type Rng_coeff_type = sig
(** The rng is supposed to be commutative.

L'annau est supposé commutatif. *)



 include Bare_rng_coeff_type
 val norm_inject: u -> t
 val norm_zero: unit -> u
 val norm_of_string: string -> u
 val norm_to_string: u -> string
 val norm_print: u -> unit
 val norm_eq: u -> u -> bool
 val norm_eq_zero: u -> bool
 val norm_compare: u -> u -> int
 val norm_add: u -> u -> u
 val norm_int_mult: int -> u -> u
 val norm_mult: u -> u -> u
 val norm_square: u -> u
end ;;




module type Field_coeff_type = sig
(** A field is commutative.

Le corps est supposé commutatif. *)



 include Bare_field_coeff_type
 val norm_inject: u -> t
 val norm_zero: unit -> u
 val norm_of_string: string -> u
 val norm_to_string: u -> string
 val norm_print: u -> unit
 val norm_eq: u -> u -> bool
 val norm_eq_zero: u -> bool
 val norm_compare: u -> u -> int
 val norm_add: u -> u -> u
 val norm_int_mult: int -> u -> u
 val norm_mult: u -> u -> u
 val norm_square: u -> u
end ;;




module type Array_type = sig
 type t
 val a: t array
 val of_string: string -> t
 val to_string: t -> string
 val print: t -> unit
 val eq: t -> t -> bool
end ;;




module Index_of_array (A:Array_type) = struct

open Util ;;

type t = 
 | Saturation
 | Witness
 | Index of int
 | Element of A.t ;;
let length = Array.length A.a ;;
let pred_length = length - 1 ;;
let index_demakeup = function (x:t) ->
 match x with
 | Index i -> i
 | _ -> failwith "Not an index of the array in Index_of_array.index_demakeup." ;;
let element_demakeup = function (x:t) ->
 match x with
 | Element y -> y
 | _ -> failwith "Not an element of the array in Index_of_array.index_demakeup." ;;
let zero = function () -> Index 0 ;;
let witness = function () -> Witness ;;
let of_string = function (s:string) ->
 match s with
 | "Saturation" -> Saturation
 | "Witness" -> Witness
 | _ ->
  begin
   try
    begin
     let t = String.sub s 0 6 in
      if compare t "Index " = 0 then
       Index ( int_of_string ( String.sub s 6 ( ( String.length s ) - 6 ) ) )
      else
       Element ( A.of_string s )
    end
   with _ -> Element ( A.of_string s )
  end ;;
let to_string = function (x:t) ->
 match x with
 | Saturation -> "Saturation"
 | Witness -> "Witness"
 | Index i -> "Index " ^ ( string_of_int i )
 | Element y -> A.to_string y ;;
let print = function (x:t) ->
 match x with
 | Saturation -> print_string "Saturation"
 | Witness -> print_string "Witness"
 | Index i -> ( print_string "Index" ; print_int i )
 | Element y -> A.print y ;;
let eq_zero = function (x:t) ->
 match x with
 | Saturation -> false
 | Witness -> false
 | Index i -> ( Pervasives.compare i 0 ) = 0
 | Element y -> A.eq y A.a.(0) ;;
let copy = function (x:t) ->
 match x with
 | Saturation -> Saturation
 | Witness -> Witness
 | Index i -> Index i
 | Element y ->
  begin
   let i = Util.vector_find_first A.eq y A.a in
    if i < 0 then failwith "Not an element of the array in Index_of_array.copy."
    else Index i
  end ;;
let to_int = function (x:t) ->
 match x with
 | Saturation -> max_int
 | Witness -> -1
 | Index i -> i
 | Element y ->
  begin
   let i = Util.vector_find_first A.eq y A.a in
    if i < 0 then failwith "Not an element of the array in Index_of_array.to_int."
    else i
  end ;;
let eq = fun (x:t) (y:t) ->
 match x with
 | Saturation ->
  begin
   match y with
   | Saturation -> true
   | _ -> false
  end
 | Witness ->
  begin
   match y with
   | Witness -> true
   | _ -> false
  end
 | Index i ->
  begin
   match y with
   | Saturation | Witness -> false
   | Index j -> i = j
   | Element yy -> A.eq ( A.a.(i) ) yy
  end
 | Element xx ->
  begin
   match y with
   | Saturation | Witness -> false
   | Index j -> A.eq ( A.a.(j) ) xx
   | Element yy -> A.eq xx yy
  end ;;
let from_int = function (i:int) ->
 match ( i < length , i >= 0 ) with
 | ( true , true ) -> Index i
 | ( false , _ ) -> Saturation
 | ( true , false ) -> Witness ;;
let compare = fun (x:t) (y:t) ->
 match x with
 | Saturation ->
  begin
   match y with
   | Saturation -> 0
   | _ -> -1
  end
 | Witness ->
  begin
   match y with
   | Witness -> 0
   | _ -> 1
  end
 | Index i ->
  begin
   match y with
   | Saturation -> -1
   | Witness -> 1
   | Index j -> Pervasives.compare i j 
   | Element yy -> Pervasives.compare i ( to_int y )
  end
 | Element xx ->
  begin
   match y with
   | Saturation -> -1
   | Witness -> 1
   | Index j -> Pervasives.compare ( to_int x ) j
   | Element yy -> Pervasives.compare ( to_int x ) ( to_int y )
  end ;;
let min = fun (x:t) (y:t) ->
 if compare x y <= 0 then
  x
 else y ;;
let max = fun (x:t) (y:t) ->
 if compare x y >= 0 then
  x
 else y ;;
let rec pred = function (x:t) ->
 match x with
 | Saturation -> Saturation
 | Witness -> Witness
 | Index i ->
  begin
   match ( i < length , i > 0 ) with
   | ( true , true ) -> Index ( Pervasives.pred i )
   | ( false , _ ) -> Saturation
   | ( true , false ) -> Witness
  end
 | Element y -> pred ( Index ( to_int x ) ) ;;
let rec succ = function (x:t) ->
 match x with
 | Saturation -> Saturation
 | Witness -> Witness
 | Index i ->
  begin
   match ( i < pred_length , i >= 0 ) with
   | ( true , true ) -> Index ( Pervasives.succ i )
   | ( false , _ ) -> Saturation
   | ( true , false ) -> Witness
  end
 | Element y ->  succ ( Index ( to_int x ) ) ;;
let rec add = fun (x:t) (y:t) ->
 match x with
 | Witness -> Witness
 | Saturation ->
  begin
   match y with
   | Witness -> Witness
   | _ -> Saturation
  end
 | Index i ->
  begin
   match y with
   | Witness -> Witness
   | Saturation -> Saturation
   | Index j -> let ii = to_int x and jj = to_int y in copy ( Index ( ii + jj ) )
   | Element yy -> add x ( Index ( to_int y ) )
  end
 | Element xx -> add ( Index ( to_int x ) ) y ;;
let rec sub = fun (x:t) (y:t) ->
 match y with
 | Witness ->
  begin
   match x with
   | Saturation -> failwith "Saturation-Witness in Index_of_array.sub."
   | _ -> Saturation
  end
 | Saturation ->
  begin
   match x with
   | Witness -> failwith "Witness-Saturation in Index_of_array.sub."
   | _ -> Witness
  end
 | Index j ->
  begin
   match x with
   | Witness -> Saturation
   | Saturation -> Witness
   | Index i -> let ii = to_int x and jj = to_int y in copy ( Index ( ii - jj ) )
   | Element xx -> sub ( Index ( to_int x ) ) y
  end
 | Element yy -> sub x ( Index ( to_int y ) ) ;;
let shift = fun (i:int) (x:t) -> add ( from_int i ) x ;;
end ;;




module type Index_type = sig
 type t
 val zero: unit -> t
 val witness: unit -> t
 val of_string: string -> t
 val to_string: t -> string
 val print: t -> unit
 val eq_zero: t -> bool
 val eq: t -> t -> bool
 val copy: t -> t
 val to_int: t -> int
 val from_int: int -> t
 val compare: t -> t -> int
 val min: t -> t -> t
 val max: t -> t -> t
 val pred: t -> t
 val succ: t -> t
 val add: t -> t -> t
 val sub: t -> t -> t
 val shift: int -> t -> t
end ;;



module Multi_index (Index:Index_type) = struct
 type t = Index.t array ;;
 let zero = function () -> Array.map Index.zero ( Array.make 1 () ) ;;
 let witness = function () -> Array.make 1 ( Index.witness () ) ;;
 let of_string = Util.bare_vector_of_string Index.of_string ;;
 let to_string = Util.bare_vector_to_string Index.to_string ;;
 let print = Util.vector_print Index.print ;;
 let eq_zero = Util.array_eq_zero Index.eq_zero ;;
 let eq = Util.array_eq Index.eq ;;
 let copy = Array.map Index.copy ;;
 let to_int = function (x:t) -> Index.to_int x.(0) ;;
 let from_int = function (x:int) -> [| Index.from_int x |] ;;
 let compare = Util.lexico_compare Index.compare ;;
 let min = Util.array_map2 Index.min ;;
 let max = Util.array_map2 Index.max ;;
 let pred = Array.map Index.pred ;;
 let succ = Array.map Index.succ ;;
 let add = Util.array_map2 Index.add ;;
 let sub = Util.array_map2 Index.sub ;;
 let shift = fun (n:int) (x:t) -> Array.map ( Index.shift n ) x ;;
end ;;





(**
§
*)

(**

Modules de calcul

 *)

(**
*)





module Zindex = struct

type t = int ;;
let zero = function () -> (0:t) ;;
let witness = function () -> (-1:t) ;;
let of_string = int_of_string ;;
let to_string = string_of_int ;;
let print = print_int ;;
let copy = function (x:t) -> (x:t) ;;
let to_int = copy ;;
let from_int = copy ;;
let compare = compare ;;
let min = min ;;
let max = max ;;
let eq_zero = ( = ) 0 ;;
let eq = ( = ) ;;
let pred = pred ;;
let succ = succ ;;
let add = ( + ) ;;
let sub = ( - ) ;;
let shift = ( + ) ;;

end ;;



module Zmulti_index = Multi_index (Zindex) ;;



module Zbare_coeff = struct

open Util ;;

type t = int ;;
type u = int ;;
type v = t ;;
let norm_inject = function (x:t) -> (x:v) ;;
let zero = function () -> (0:t) ;;
let of_string = int_of_string ;;
let to_string = string_of_int ;;
let print = print_int ;;
let copy = function (x:t) -> (x:t) ;;
let eq_zero = function (x:t) -> ( compare x 0 = 0 ) ;;
let eq = fun (x:t) (y:t) -> ( x = y ) ;;
let compare = compare ;;
let norm = function (x:t) -> (abs x) ;;
let opp = function (x:t) -> (- x:t) ;;
let add = fun (x:t) (y:t) -> (x + y:t) ;;
let sub = fun (x:t) (y:t) -> (x - y:t) ;;
let int_mult = fun (x:int) (y:t) -> (x * y:t) ;;
let mult = fun (x:t) (y:t) -> (x * y:t) ;;
let square = fun (x:t) -> (x * x:t) ;;
let int_pow = fun (n:int) (x:t) -> ( ( Util.int_power n x ):t ) ;;

let one = function () -> (1:t) ;;
let eq_one = function (x:t) -> ( compare x 1 = 0 ) ;;

end ;;




module Nbare_coeff = struct

open Util ;;

type t = int ;;
type u = t ;;
type v = t ;;
let norm = function (x:t) -> (x:u) ;;
let norm_inject = function (x:t) -> (x:v) ;;
let zero = function () -> (0:t) ;;
let of_string = int_of_string ;;
let to_string = string_of_int ;;
let print = print_int ;;
let copy = function (x:t) -> ( assert ( x >= 0 ) ; x:t ) ;;
let eq = fun (x:t) (y:t) -> ( assert ( x >= 0 ) ; assert ( y >= 0 ) ; x = y ) ;;
let eq_zero = eq ( zero () ) ;;
let compare = fun (x:t) (y:t) -> ( assert ( x >= 0 ) ; assert ( y >= 0 ) ; compare x y ) ;;
let opp = Util.int_identity ;;
let add = fun (x:t) (y:t) -> ( assert ( x >= 0 ) ; assert ( y >= 0 ) ; x + y:t) ;;
let sub = fun (x:t) (y:t) -> ( assert ( x >= 0 ) ; assert ( y >= 0 ) ; assert ( y >= x ) ; x - y:t ) ;;
let int_mult = fun (x:int) (y:t) -> ( assert ( x >= 0 ) ; assert ( y >= 0 ) ; x * y:t ) ;;
let mult = fun (x:t) (y:t) -> ( assert ( x >= 0 ) ; assert ( y >= 0 ) ; x * y:t ) ;;
let square = fun (x:t) -> ( assert ( x >= 0 ) ; x * x:t ) ;;
let int_pow = fun (n:int) (x:t) -> ( assert ( x >= 0 ) ; ( ( Util.int_power n x ):t ) ) ;;

end ;;




module Nbare_mult = struct

(** This module is aimed at working on natural integer multiplication and at building sparse vectors by omitting the occurrences of the neutral element 1.

Ce module sert à travailler sur la multiplication des entiers naturels et à construire des vecteurs creux en omettant les occurrences de l'élément neutre 1. *)


type t = int as 't ;;
type u = int as 'u ;;
type v = t ;;
let norm_inject = function (x:t) -> (x:v) ;;
let zero = function () -> (1:t) ;;
let of_string = int_of_string ;;
let to_string = string_of_int ;;
let print = print_int ;;
let copy = function (x:t) -> ( assert ( x >= 0 ) ; x:t ) ;;
let eq = fun (x:t) (y:t) -> ( assert ( x >= 0 ) ; assert ( y >= 0 ) ; x = y ) ;;
let eq_zero = eq ( zero () ) ;;
let compare = fun (x:t) (y:t) -> ( assert ( x >= 0 ) ; assert ( y >= 0 ) ; compare x y ) ;;
let norm = copy ;;
let opp = copy ;;
let add = fun (x:t) (y:t) -> ( assert ( x >= 0 ) ; assert ( y >= 0 ) ; x * y:t) ;;
let sub = fun (x:t) (y:t) -> ( assert ( x >= 0 ) ; assert ( y >= 0 ) ; assert ( y >= x ) ; x / y:t ) ;;
let rec power = fun (x:int) (y:t) ->
 assert ( x >= 0 ) ; assert ( y >= 0 ) ;
 match x with
 | 0 -> 1
 | 1 -> y
 | 2 -> y * y
 | _ ->
  begin
   match x mod 2 with
   | 1 -> y * ( power ( pred x ) y )
   | _ -> let z = power ( x / 2 ) y in z * z
  end ;;
let int_mult = power ;;
let mult = fun (x:t) (y:t) -> ( assert ( x >= 0 ) ; assert ( y >= 0 ) ; x * y:t ) ;;
let square = fun (x:t) -> ( assert ( x >= 0 ) ; x * x:t ) ;;
let int_pow = power ;;

end ;;




module Rbare_coeff = struct

type t = float ;;
type u = float ;;
type v = t ;;
let norm_inject = function (x:t) -> (x:v) ;;
let zero = function () -> 0. ;;
let one = function () -> 1. ;;
let of_string = float_of_string ;;
let to_string = string_of_float ;;
let print = print_float ;;
let copy = function (x:t) -> (0. +. x:t) ;;
let eq_zero = function (x:t) -> ( compare x 0. = 0 ) ;;
let eq_one = function (x:t) -> ( compare x 1. = 0 ) ;;
let eq = fun (x:t) (y:t) -> ( compare x y = 0 ) ;;
let compare = compare ;;
let norm = function (x:t) -> (abs_float x) ;;
let opp = function (x:t) -> (-. x:t) ;;
let add = fun (x:t) (y:t) -> (x +. y:t) ;;
let sub = fun (x:t) (y:t) -> (x -. y:t) ;;
let int_mult = fun (x:int) (y:t) -> ( ( float x ) *. y :t ) ;;
let mult = fun (x:t) (y:t) -> (x *. y:t) ;;
let square = fun (x:t) -> (x *. x:t) ;;
let inv = function (x:t) -> (1. /. x :t)
let div = fun (x:t) (y:t) -> (x /. y:t) ;;
let int_div = fun (x:int) (y:t) -> ( y /. ( float x ) :t ) ;;
let int_pow = fun (x:int) (y:t) -> ( y ** ( float x ) :t ) ;;

end ;;




module Big_int_index = struct

include Big_int ;;

type t = Big_int.big_int ;;
let zero = function () -> Big_int.zero_big_int ;;
let witness = function () -> Big_int.big_int_of_int ( - 1 ) ;;
let of_string = Big_int.big_int_of_string ;;
let to_string = Big_int.string_of_big_int ;;
let print = function x -> print_string ( Big_int.string_of_big_int x ) ;;
let eq = Big_int.eq_big_int ;;
let eq_zero = eq ( zero () ) ;;
let copy = function x -> Big_int.minus_big_int ( Big_int.minus_big_int x ) ;;
let to_int = Big_int.int_of_big_int ;;
let from_int = Big_int.big_int_of_int ;;
let compare = Big_int.compare_big_int ;;
let min = Big_int.min_big_int ;;
let max = Big_int.max_big_int ;;
let pred = Big_int.pred_big_int ;;
let succ = Big_int.succ_big_int ;;
let add = Big_int.add_big_int ;;
let sub = Big_int.sub_big_int ;;
let shift = Big_int.add_int_big_int ;;

end ;;




module Big_int_bare_coeff = struct

include Big_int ;;

type t = Big_int.big_int ;;
type u = Big_int.big_int ;;
type v = t ;;
let norm_inject = function (x:t) -> (x:v) ;;
let zero = function () -> Big_int.zero_big_int ;;
let one = function () -> Big_int.unit_big_int ;;
let of_string = Big_int.big_int_of_string ;;
let to_string = Big_int.string_of_big_int ;;
let print = function x -> print_string ( Big_int.string_of_big_int x ) ;;
let copy = function x -> Big_int.minus_big_int ( Big_int.minus_big_int x ) ;;
let eq = Big_int.eq_big_int ;;
let eq_zero = eq ( zero () ) ;;
let eq_one = eq ( one () ) ;;
let compare = Big_int.compare_big_int ;;
let norm = Big_int.abs_big_int ;;
let opp = Big_int.minus_big_int ;;
let add = Big_int.add_big_int ;;
let sub = Big_int.sub_big_int ;;
let int_mult = Big_int.mult_int_big_int ;;
let mult = Big_int.mult_big_int ;;
let square = Big_int.square_big_int ;;
let int_pow = fun (x:int) (y:t) -> Big_int.power_big_int_positive_int y x ;;

end ;;




module Num_index = struct

include Num ;;

type t = Num.num ;;
let zero = function () -> Num.num_of_int 0 ;;
let witness = function () -> Num.num_of_int ( - 1 ) ;;
let of_string = Num.num_of_string ;;
let to_string = Num.string_of_num ;;
let print = function x -> print_string ( Num.string_of_num x ) ;;
let copy = function x -> Num.minus_num ( Num.minus_num x ) ;;
let eq = Num.eq_num ;;
let eq_zero = eq ( zero () ) ;;
let to_int = Num.int_of_num ;;
let from_int = Num.num_of_int ;;
let compare = Num.compare_num ;;
let min = Num.min_num ;;
let max = Num.max_num ;;
let pred = Num.pred_num ;;
let succ = Num.succ_num ;;
let add = Num.add_num ;;
let sub = Num.sub_num ;;
let shift = fun (x:int) (y:t) -> Num.add_num ( Num.num_of_int x ) y ;;

end ;;




module Num_bare_coeff = struct

include Num ;;

type t = Num.num ;;
type u = Num.num ;;
type v = t ;;
let norm_inject = function (x:t) -> (x:v) ;;
let zero = function () -> Num.num_of_int 0 ;;
let one = function () -> Num.num_of_int 1 ;;
let of_string = Num.num_of_string ;;
let to_string = Num.string_of_num ;;
let print = function x -> print_string ( Num.string_of_num x ) ;;
let copy = function x -> Num.minus_num ( Num.minus_num x ) ;;
let eq = Num.eq_num ;;
let eq_zero = eq ( zero () ) ;;
let eq_one = eq ( one () ) ;;
let compare = Num.compare_num ;;
let norm = Num.abs_num ;;
let opp = Num.minus_num ;;
let add = Num.add_num ;;
let sub = Num.sub_num ;;
let int_mult = fun (x:int) (y:t) -> Num.mult_num ( Num.num_of_int x ) y ;;
let mult = Num.mult_num ;;
let square = Num.square_num ;;
let inv = Num.div_num ( one () ) ;;
let div = Num.div_num ;;
let int_div = fun (x:int) (y:t) -> Num.div_num y ( Num.num_of_int x ) ;;
let int_pow = fun (x:int) (y:t) -> Num.power_num y ( Num.num_of_int x ) ;;

end ;;




module Ratio_bare_coeff = struct

include Ratio ;;

type t = Ratio.ratio ;;
type u = Ratio.ratio ;;
type v = t ;;
let norm_inject = function (x:t) -> (x:v) ;;
let zero = function () -> Ratio.ratio_of_int 0 ;;
let one = function () -> Ratio.ratio_of_int 1 ;;
let of_string = Ratio.ratio_of_string ;;
let to_string = Ratio.string_of_ratio ;;
let print = function x -> print_string ( Ratio.string_of_ratio x ) ;;
let copy = function x -> Ratio.minus_ratio ( Ratio.minus_ratio x ) ;;
let eq = eq_ratio ;;
let eq_zero = eq ( zero () ) ;;
let eq_one = eq ( one () ) ;;
let compare = Ratio.compare_ratio ;;
let norm = Ratio.abs_ratio ;;
let opp = Ratio.minus_ratio ;;
let add = Ratio.add_ratio ;;
let sub = Ratio.sub_ratio ;;
let int_mult = Ratio.mult_int_ratio ;;
let mult = Ratio.mult_ratio ;;
let square = Ratio.square_ratio ;;
let inv = Ratio.inverse_ratio ;;
let div = Ratio.div_ratio ;;
let int_mult = Ratio.mult_int_ratio ;;
let int_div = fun (n:int) (y:t) -> Ratio.div_ratio_int y n ;;
let rec int_pow = fun (n:int) (y:t) ->
 if n >= 0 then
  Ratio.power_ratio_positive_int y n
 else int_pow ( - n ) ( inv y ) ;;

end ;;




module Complex_coeff : Field_coeff_type = struct

include Complex ;;

let zero = function () -> Complex.zero ;;
let one = function () -> Complex.one ;;

type u = float ;;
let norm_inject = function (x:float) -> ({re=x;im=0.}:t) ;;
let of_string = function s ->
 let listing = Str.split ( Str.regexp " +i " ) s in
  { Complex.re = float_of_string ( List.hd listing ) ; Complex.im = float_of_string ( List.hd ( List.tl listing ) ) } ;;
let to_string = function x ->
 ( string_of_float x.Complex.re ) ^ " +i " ^ ( string_of_float x.Complex.im ) ;;
let print = function x ->
 begin
  print_float x.Complex.re ;
  print_string "+i" ;
  print_float x.Complex.im ;
 end ;;
let copy = function x -> { Complex.re = x.re ; Complex.im = x.im } ;;
let eq_zero = function x -> ( Complex.norm2 x ) == 0. ;;
let eq = fun x y -> eq_zero ( Complex.sub x y ) ;;
let eq_one = eq Complex.one ;;
let compare = fun x y -> compare ( Complex.norm x ) ( Complex.norm y ) ;;
let opp = Complex.neg ;;
let int_mult = fun x y ->
 begin
  let z = { Complex.re = ( float x ) ; Complex.im = 0. } in
   Complex.mul z y
 end ;;
let mult = Complex.mul ;;
let square = fun x -> Complex.mul x x ;;
let int_div = fun x y ->
 begin
  let z = { Complex.re = ( float x ) ; Complex.im = 0. } in
   Complex.div y z
 end ;;
let int_pow = fun x y ->
 begin
  let z = { Complex.re = ( float x ) ; Complex.im = 0. } in
   Complex.pow y z
 end ;;
 let norm_zero = function () -> 0. ;;
 let norm_of_string = float_of_string ;;
 let norm_to_string = string_of_float ;;
 let norm_print = print_float ;;
 let norm_eq = fun (x:u) (y:u) -> x = y ;;
 let norm_eq_zero = function (x:u) -> x = 0. ;;
 let norm_compare = fun (x:u) (y:u) -> Pervasives.compare x y ;;
 let norm_add = ( +. ) ;;
 let norm_int_mult = fun (n:int) (x:float) -> ( float n ) *. x ;;
 let norm_mult = ( *. ) ;;
 let norm_square = function x -> x *. x ;;

end ;;




module Int32_index = struct

include Int32 ;;

let zero = function () -> Int32.zero ;;

let witness = function () -> Int32.minus_one ;;
let of_string = Int32.of_string ;;
let to_string = Int32.to_string ;;
let print = function x -> print_string ( Int32.to_string x ) ;;
let copy = function x -> Int32.neg ( Int32.neg x ) ;;
let eq = fun x y -> compare x y == 0 ;;
let eq_zero = eq ( zero () ) ;;
let from_int = Int32.of_int ;;
let shift = fun x y -> Int32.add ( Int32.of_int x ) y ;;
let min = Pervasives.min ;;
let max = Pervasives.max ;;

end ;;




module Int32_bare_coeff = struct

open Util ;;
include Int32 ;;

let zero = function () -> Int32.zero ;;
let one = function () -> Int32.one ;;

type u = Int32.t ;;
type v = t ;;
let norm_inject = function (x:t) -> (x:v) ;;
let of_string = Int32.of_string ;;
let to_string = Int32.to_string ;;
let print = function x -> print_string ( Int32.to_string x ) ;;
let copy = function x -> Int32.neg ( Int32.neg x ) ;;
let eq = fun x y -> compare x y == 0 ;;
let eq_zero = eq ( zero () ) ;;
let eq_one = eq ( one () ) ;;
let norm = Int32.abs ;;
let opp = Int32.neg ;;
let mult = Int32.mul ;;
let square = function x -> Int32.mul x x ;;
let int_mult = fun x y -> mult ( Int32.of_int x ) y ;;
let int_pow = fun (n:int) (x:t) -> Int32.of_int ( Util.int_power n ( Int32.to_int x ) ) ;;

end ;;




module Int64_index = struct

include Int64 ;;

let zero = function () -> Int64.zero ;;

let witness = function () -> Int64.minus_one ;;
let of_string = Int64.of_string ;;
let to_string = Int64.to_string ;;
let print = function x -> print_string ( Int64.to_string x ) ;;
let copy = function x -> Int64.neg ( Int64.neg x ) ;;
let eq = fun x y -> compare x y == 0 ;;
let eq_zero = eq ( zero () ) ;;
let from_int = Int64.of_int ;;
let shift = fun x y -> Int64.add ( Int64.of_int x ) y ;;
let min = Pervasives.min ;;
let max = Pervasives.max ;;

end ;;




module Int64_bare_coeff = struct

open Util ;;
include Int64 ;;

let zero = function () -> Int64.zero ;;
let one = function () -> Int64.one ;;

type u = Int64.t ;;
type v = t ;;
let norm_inject = function (x:t) -> (x:v) ;;
let of_string = Int64.of_string ;;
let to_string = Int64.to_string ;;
let print = function x -> print_string ( Int64.to_string x ) ;;
let copy = function x -> Int64.neg ( Int64.neg x ) ;;
let eq = fun x y -> compare x y == 0 ;;
let eq_zero = eq ( zero () ) ;;
let eq_one = eq ( one () ) ;;
let norm = Int64.abs ;;
let opp = Int64.neg ;;
let mult = Int64.mul ;;
let square = function x -> Int64.mul x x ;;
let int_mult = fun x y -> mult ( Int64.of_int x ) y ;;
let int_pow = fun (n:int) (x:t) -> Int64.of_int ( Util.int_power n ( Int64.to_int x ) ) ;;

end ;;




module Nativeint_index = struct

include Nativeint ;;

let zero = function () -> Nativeint.zero ;;

let witness = function () -> Nativeint.minus_one ;;
let of_string = Nativeint.of_string ;;
let to_string = Nativeint.to_string ;;
let print = function x -> print_string ( Nativeint.to_string x ) ;;
let copy = function x -> Nativeint.neg ( Nativeint.neg x ) ;;
let eq = fun x y -> compare x y == 0 ;;
let eq_zero = eq ( zero () ) ;;
let from_int = Nativeint.of_int ;;
let shift = fun x y -> Nativeint.add ( Nativeint.of_int x ) y ;;
let min = Pervasives.min ;;
let max = Pervasives.max ;;

end ;;




module Nativeint_bare_coeff = struct

open Util ;;
include Nativeint ;;

let zero = function () -> Nativeint.zero ;;
let one = function () -> Nativeint.one ;;

type u = Nativeint.t ;;
type v = t ;;
let norm_inject = function (x:t) -> (x:v) ;;
let of_string = Nativeint.of_string ;;
let to_string = Nativeint.to_string ;;
let print = function x -> print_string ( Nativeint.to_string x ) ;;
let copy = function x -> Nativeint.neg ( Nativeint.neg x ) ;;
let eq = fun x y -> compare x y == 0 ;;
let eq_zero = eq ( zero () ) ;;
let eq_one = eq ( one () ) ;;
let norm = Nativeint.abs ;;
let opp = Nativeint.neg ;;
let mult = Nativeint.mul ;;
let square = function x -> Nativeint.mul x x ;;
let int_mult = fun x y -> mult ( Nativeint.of_int x ) y ;;
let int_pow = fun (n:int) (x:t) -> Nativeint.of_int ( Util.int_power n ( Nativeint.to_int x ) ) ;;

end ;;




(**
§
*)

(**

Autres modules de calcul

 *)

(**
*)





module Zcoeff = Normalize_rng_coefficient (Zbare_coeff) (Zbare_coeff) ;;

module Ncoeff = Normalize_rng_coefficient (Nbare_coeff) (Nbare_coeff) ;;

module Nmult = Normalize_rng_coefficient (Nbare_mult) (Nbare_mult) ;;

module Rcoeff = Normalize_field_coefficient (Rbare_coeff) (Rbare_coeff) ;;

module Big_int_coeff = Normalize_rng_coefficient (Big_int_bare_coeff) (Big_int_bare_coeff) ;;

module Num_coeff = Normalize_field_coefficient (Num_bare_coeff) (Num_bare_coeff) ;;

module Ratio_coeff = Normalize_field_coefficient (Ratio_bare_coeff) (Ratio_bare_coeff) ;;

module Int32_coeff = Normalize_rng_coefficient (Int32_bare_coeff) (Int32_bare_coeff) ;;

module Int64_coeff = Normalize_rng_coefficient (Int64_bare_coeff) (Int64_bare_coeff) ;;

module Nativeint_coeff = Normalize_rng_coefficient (Nativeint_bare_coeff) (Nativeint_bare_coeff) ;;






module Classical = struct




(**
§
*)

(**

Constantes classiques sous forme de chaînes de caractères

Classical constants as character strings

 *)

(**
*)





(** The foolowing constants come from the following sites.

http://numbers.computation.free.fr/Constants/constants.html

http://www.plouffe.fr/simon

http://www.gutenberg.org/files/634

http://pi.lacim.uqam.ca/eng/table_en.html

Les constantes qui suivent proviennent des sites précédents. *)




(** 
log_golden_string_10000
*)

let log_golden_string_10000 = "0.4812118250596034474977589134243684231351843343856605196610181688401638676082217744120094291227234749972318399582936564112725683237267376227530592418644097541824170072118371502238239374691872752432791930187970790035617267969445457523053454341887652855325649020739969349661875563010212399636793082063599779885099801568257978526493286666511162417138082725927884790260965331132472275149314064985088932176366002566661953210679681757661847307351598603984845754541205632341357004780063948722431526178968004509363905250349047854335219786537043719390335767724167037041764176797803196523209965675879542161317599788574175988306925239971759004645396055755125469296880790336704962135629449255512038393177469765482697754190900214828759179501041031500917204028518197630188334350759930550758126742131303293499107738876675178035135238757650875666509752111519250980532516177233541496905119103137600082981575323964460993136111783955496523733378062445115897253853812562532446710539275623369281196653779619758917666711095846373635984559743713594359205348907572626134582145432765916779908062924397273146856553631409231139189506310853969663757752751107957770517712484274943740982345012679136495821968188838111560171096712333553833393927027500996720494391733688939579967413076359772832609510175636412038768001722957454572708016286972619429337293496654818725708422707366710815114327874018411533293144513474774751957004799746467657364148361049490328090224977622570298623097360858084527593579340622723616075197108846198450231055953805131642186394723985949464523407023404695538356521638888240772996218395060329653693601062831060098398024984260312819460740419546867869875428998025010875172629537087282918483141901299015195497581346204958161557076536275408455582569601221217349674108040405197845191507151281491018225467512962485858122272225598856111210792935272906907212882689099882576885797750307066556054049109149910939500241624925360297087329857661801186211048901508816498477747069673947411645334344446340470690006498408237709942932016762643585118966390436158049781605214024004262049116737966574417352529356656455186000812095906122093527146388901360491418721286084139699959434973433934376722342181920344232129866781750549633956424458745932755364862248477121264447340832131239553458204964301447713309060759914392703285096703893137511239930290348673464249226926612973804639965576446022145231435034546083828144598651041504251064718978932868463904943054928457679918835767222676561600840748984389726709241983710706923192732063876733644488007516935311990855196214717912115296308609697402176224644906531851370660778827084196343580628916160959533423218437233430425266264388031724587610882607106530929806994982347449181952390523813043434132005345537271832815045045839415778033178934113738916448262563999750334456122749149128586452920197229957013325519294870352959150772310809095291332171081215280141781336193020131017910551777178930570039164058238302012773100657961511135373289413229475120588043354623916970493649795457344026039683719248789073292392519924921918545393368584427973554431047056610222790108954501039988155966771546929950953368222488131882846323481980331990938144349412046521851359510433381070156601472226545279663438798008544216317506642784222441067866675839394693778347292202665513814498515133425988791174391661982707713468332680581875501288525126547158350819424505848065240533199360837633828999332739008421512425119716155817838723949418316015000716054938898624165005289807325949442945172844548310933443862092536645818017447852326574765630226900028432224435616237419847260663915913529140078103652388492547367058369423721900849236663800333349994870178236672154718531934618627048784856556052248361178821014823741177006315766773326803862365715773352647331647582139729528141132759296647623365867336728229478722463745376596179070931437185427616863226139308624316954330987663082499104565229204012172592566099777422236931664918396642817232441306709026822062268324652465856171510865935063432366233746088706211483151726852143697002247925464692334749149551940358917748267208008808213697717437570896052381031278024213915321950630466777123231705286294675897424624006489954692706705901392205956088272510674062064706013306217823454859040767697989777216441223438057885389543397074771147937061599497603422948970014364809164767470889577515658766514902611265113376979730432032404370019884339286015622483062704454543436629774380949158508278526743117839821938038239609478309883483262356877603893541568682824583838058966170586151227047691195199355842646562798271971731603135512253324885872262594475840399367130225670853826844627638814063202220389854082182583569062971109255856931802107512023870245545501843469985416507352588262033544971937044196212066878372305910363078751056405712920439395434038466668219665799201654272624487358704907639012424707807271832003738792558135305356971346583245595369191372250859611240404780057941235389172855409485316652479849064480884994598349942439155678870079275476181751271203992788859393951384853279199527508689307176874183523173802566865124103871617544327248167448396966831434957494991462133381934975112493793073953209430582223171461885172114002499877572563890958012696455803806083789734105876262978049128661243876296739717608519412348922977228124958921169018643151123627378779217073901285036839711411004051309015632063083861163118919392585311463838673406306770141606650493682143055521812102452021642664635088329634714053143121714036829964010799471212654763624127324904803822208213039120621792668963595970790492639367960651821326714830662336244976307920750133942203270301314811081092946002227474965764298297729151444510781444818786868463022778806640541895576505846653447276843830685509083766285956301095305077086307898165502064014203794129994273969279241929754289281686660359759013461136577624123855522115428861956702553839761415200818667739864621972041967587899006630130340105938209844229747118837206366984045516940880007885640976692462262714543415582343808722071902250018603486742590390565143596849121338199359728949992241117705027705269430315592298716811705403665479793356636252963251410227408619665505482446733569969825659833889658005372151911108560424072171962314422526670863605660342198282766357864856260582952498614169602082741762645526263822536114030298403050531836567245260083866358232945499953396088792962755745449261129170349030414809322656530251833012796815962088483920446327115232113818741810296100590554397993024702860886996900798394051112972914694944097722181678602286483968469259157511196174214798902583271891235636442039287917202267240362249872812210892743542682913867003145481988063413443463610001547896404667020786008920946579968299324668500259830986313139592014536628046750702536582331836009421308358458041203037006872783738486096102253236154494974188314628590661995241281723087239424244226113676536684029729265025384515365136018362765837395832848185991041009577157935487124191247006928051323530122654201035804245514773541805177537725061831364615795447717788234131487277607474892569203521261713604292471333614476941464907225602884111526411378318200823656701636952787374280270918083918507093784037370483890159415473657140477866302724364410570474652329210416549888371385581120845007447049855047874648871687000441780886670732464507714670707391527185969354125200453831442863204792116087361482457500960462937935232570521600762954759348093681953778253912839127872691681578738402960407595100978880807728228387671944000221368229537060579396141931535475094619470613081614682624810641472022259697842794996954322072335321253019652894922103275761208185828195366180313640490280671739621254504699209332389567480750462697590979731582109843789983132322982995617254509582647326126496034537558799944852178372326944707956626838207716985290615713362048828434325073034484131474219758873220004858429024744940592695137632012898960789202381091880122893324601036336490030103466001902207631101175233781623414731393354079869515469814785055155637508678309367515611283908908923789648714237745735658027370973688582751883161213855899004317583361982213504086171556805852980673824495439146337594841787210941470774712270062843099259422971357206834725594115083998053213869590047261160466151299735121282898521918621593702477534707532188049403753573001247317088792097386975367201025741268988367456401740174692488297073531479315093492276897686284407674087245672037366708204747583450179397031283830876913602454271554508827005664393136832184002808119632658053182407494486587338354812664782883574014484975606310639250063916940478299504284702595093646338926532027064335788336277244144326762865284176444698526959990687897007012694943244547419101528415943590697732201538188543237728671341339844190531578377929909798494817314838256011985486576767377101659462391816682230590874847885302389849563808723372685537865729503408299361506552419073067548143448548096696200434526121496007482588054425603114777984375867005739493385546623020096442863402270664272146176707325340490398407677611910227375642606659952446313983688654583946669399207502698975407367029011756656798018401608457761866278972016020964842252744971182395039764426039418707407242698738930580852145056483844986721492558235106644319238403579497972822398905514574535846185529812842657835180036630206948071643158318898830530910357515880220214917268773259316311361002887533750648164083463986703447726858173258246464327615214230704634062992788408631978861284882444029439094927481407018018908798214520587314650214238139947896665738054774119493340153576198361722463950688605690584809298742664389988246012373879993950079762996330936705051820399878387963580400131173448999686728295299368301688233204749951609006180014082292658151333165018360639132725968154365358748252273674750884493317016723755340744559471236711131936580313525127352035560552632314517876562683967120907597871921596618603244372353498792456339743077982398958455909868890300770578512639767282965195054619213164176856381275834158983306859177141087561619603711535497113844658181579391087588581288228672858921791119322682834" ;;

(** 
minus_log_gamma_string_10000
*)

let minus_log_gamma_string_10000 = "0.5495393129816448223376617688029077883306989812630647910901513045766314200557530475626189891127614068414669275791904049552631859054504177345498480782071293952562877250947038762816882709756100261156408875886889419139970426537839323510832374953687141792987794300069880315290600683639235518681938477355838055941683908658625028415530607539073443426079096506259130306459342300654123610600411186074892174667506461526100843421125988247546108823882428539431645428158950629093728556406317128605732826016142915026344987479096915676760238965066198922542860172655561376682328799791067633962776903826327089219839457230041344361865407953362338720245711646069144253878683180659814417910627323287329858943584044645135699068350674958629650724770556945099832920562888564823289388701438064548296318506275719460957159631960983323959080438147279242020449516309967614652725194757081874853600018054128706301610588656010970155924397676699890942559296818707291600767890083939927817943034763903514203857308736435378434747170357841069573597602072345417673763593058398591235964970487144826967382947214887301113012370032732595014870302066832995169747590973651507298881264720210210237808281614652007290132829186171348102975466465614350763290668445570634147485609480839050188772704282737338590069236755582916255829482432478153387376913631734703037422942385614077265209961667169490739221440775521596752163802039336005273301277037266102140294537067303648491632368361531293279481977257748673215463271775993359718843738600992403649766235845872572321624353540416488977205289970032184532040235035937760825731753561001124037462261978559160478765371877573964139631302864887432703703032016519121651424150373196543952487670911359298397192857044618699989029398835942480579316835665225619741764284963634273029397074603460592139080074608043899416821722643620273174330827588279509429602729908495763342599387620113169830041011349501599459547094360421404886823661303733326213900779947452944135560647813338983749624179664151580158516725761690508754135292190335697182383543723284947396079110799283982353086244656517096760423215270824241900581089861967163772156111895763092653867381933839051969713524956419339585998807348506302458287239147348019599233657375620730188641853447615060732561220659228755914671496971401285758339469623153361313554888645525526991542499984461378563169591703824944488900616243121003801972614440332296419770447983521152748579965696078935077747587177688670650636364224959598230232191348543369843530960436165137213639923021939254079728116717418913400930246561234381204213935883388655731628471621043987063681729635376050359592662443002244942364909517574340168135803846663369840686842514488353922277524974133354639050227743332828303181367756504701080895399098988141838996055649658381129108945988196285687305032325688372756623643320803207285553759651050463744054114759211279196351884334324508469509342421663773811523705168696265178746299766705099523779846096598624906171610844258845578601005585999459626812316287717810744051198874042672102082435561414501785024125151073378091474909815771416584497047224022799442619937417614470601959147216331224632039660793250913457180601064063978547302277258838323987003587045125859327817789527754953934475378997382226336245581849973800108629628041174754673685301709662659812006532274049031471334968644407202712995448484701194719410452932612006817014365020813622931650266257975403461851131072186374244575765347796168099422881890594116088016379189919497373424477547859620996692561451776669233176049853421081517264973126687482439220219262619134764590481800042324646905531383558901167107498450208460595445370989165007861833397921516490888630654576774518120915736337388636426943781563784999973062041851652960624275813542922410390262974921510139572391540131446017387403242374472039759658187792721163557170059474310079259912657091182434365142331880648990763554594790924621557446345616316281154971903300850452113166957704620971522246069271560382518075417283883732112585522623855922811067511309658743850420885043944537392103025830508434173003544467966996783771377998360126738527861273637146438776264488702315981336153956435372398562601203650323466899824248906769353748433593776429974968491329906433514282535749512737742220315629388296391711653342462900290836186941087470750509671817122914842578591976705593269246675833320230003980806979886170921963158554409690415538088718879143462533825692849071191061288299178055900885772006745990756807195510138003785283468657870959133947493856259764053741747504341285341289265385662500233272719142675721058459401341654256776431161554502652280949361649350420531201976899105153383020089917330988885548835314799345159757692484944911177692291101249673319421856595320763619945943839518159506999147064172270227624929943376112344556123053444878479629792276026636861039375652262949222972921978651973472178306543634561559957517644855894575955734006095246569296990472611901359011338637032021598411422108163399951534427310426145178805576687541104443601515767441376377321101252822634628952470978260917513603721318031689998758439721998947435649070402704713066447423145656985037388905487087918047618180778922039995053002663237754244684192268262721901837091526691870472092391061578195474865209516718207336430232036238140020875757258207661996455146634719954172885728034248187044303322713385596457532206175082217361891238393982234467134552782320287351280948890568960938293024623012430063775785115396169225066667868464695479269697877847919265745755575141034161953144613543464726920295480787000121818389441621801319057535437655001957140018263507725103018672898139710393237389676699355020422311022209632823921542323860790641145933870361407507537461544016559844948385164147467133441331986877538735305578490463327841825492455055425772191098427141539946030973260843457580249851432802802403739912939612820668846489447966117705675506047295467457548410654079838463277890246191885913402967540089981596757274987561893642733162381693228737073772322856914758561216107367183777814032444070990542917594251721920142731233040534969122613290342886133182601253429806961160166853750259958893863317093827912062979756311020449007910537979890285317165087417868779944117031158573965456915663288284653052754760732610714717150604034211682360605974712094156086767157933179626796598005002193758236825370178710970905212564858293999093135096366863978188858593472301046608480772931481308303767764588436733506199019091771441198189612687567721839869246884794560369349137742420895558746954257497541512714958743402090524149016212549976017041567696407137728083315871554582523835236667021061393129173650398961903210446164557930520095066823469733191890623089136801004388264427997475312951216000721890471995367813774588340046063374904621776304790262373492941654017082189184637810935050499237884477300593832186437722948458116308060251353714227019839039386912724056758466216793367340987313501220947938328861234854638154686935607230857875109361347707981140375940019414487931742919397809572033765684217514754206368748999569319447924009378144978009557223732016638839416951958692812124977718518846229122317381191673816406901721854872397570349107112468513507920949877290293838271294729997696454620699796326727460277454825997590196525633074052090501530294899233018326063185580092172175406801062118015673556480844297302669432221578068414775535900978645059192151247771621344830864689263561324384142785062335398590007616976716621374002565760778889088084723174770810702420124729015613688231171367908444779057635270057868258865224906753759560348845654088219182848029059167733660853670439769201736352920267886526053705139394641681731808472415600388784225705169344957165172890270668641772444810285528770894444633881438649527979675018857514155729235278748886029681968381393695539471328391700072955726123547598146172608318711973872928791133001563227899326207057930863611282398860571072145628842454646194667613890903482110934319762069781204637534418304149515316702509924662755100288917665355234548785030223608916037233290063092917423185650149839436406392823984351401630047742535208641090528339955208621509017440314584739211957779533236382981811712228170397791017755372954545395850586980159677815988706861751948433458258928890523262266099833149022914974765505102002976201714186428582021646275030660878206208656540548297712976941910149903139743041005423542211405505166353465278190765175381488230720823794542939534665347302519652276616515632376059976863358217357149464234640380405688386531457256621526970985838260085334950164669664705818748803368820702467962784630707799268888093549161297394520392431182646568679490250310103149967250670087271704223334766551680624111598747235802223813477644726351567283068990720583791349539708796596000304148798859776654991044008383348431184399684075844614119915327991286295171936817373166395374519476844514092880292580671151592878774958806934392224041738687519309901896916325675898353030309477976969966174713582099851215355137187964501427167228064184617854347468235912863412475770519613917927098427982218908984362074503759958929348923141331043201413577696544806621219311430051662183895062419308095312062000525848278848665689092936999005762923821717110337475250879929662057536960462392463191934210370357112635701127107522744880974232942907859704287058182481154362122258411813463116911655026318507584187487477097320675639997998663023099227989993264407915552100887176416787873543795151344431198569972997168857138106457598222462375558621353714608232091287890441041087349408950283824165338211787951770939771856824782601883875056763749173329490929195380691281182234808829646666864188606956600627635278903748289276555226769865008727579580098864840322083507417229558023257985168955466483356038403067557142472602195169657296493201281882597464459943944722701079878971736389664942698661841221984383392784228543848974495222787963548080495850641195971606018791839048071942694430715707212117605700089370703085980700780545857039072458276483746590556074509257848726400637437454920948677717389955115888052143500954867523561533364" ;;

(** 
log_2_string_1000
*)

let log_2_string_1000 = "0.69314718055994530941723212145817656807550013436025525412068000949339362196969471560586332699641868754200148102057068573368552023575813055703267075163507596193072757082837143519030703862389167347112335011536449795523912047517268157493206515552473413952588295045300709532636664265410423915781495204374043038550080194417064167151864471283996817178454695702627163106454615025720740248163777338963855069526066834113727387372292895649354702576265209885969320196505855476470330679365443254763274495125040606943814710468994650622016772042452452961268794654619316517468139267250410380254625965686914419287160829380317271436778265487756648508567407764845146443994046142260319309673540257444607030809608504748663852313818167675143866747664789088143714198549423151997354880375165861275352916610007105355824987941472950929311389715599820565439287170007218085761025236889213244971389320378439353088774825970171559107088236836275898425891853530243634214367061189236789192372314672321720534016492568727477823445353476" ;;

(** 
log_2_string_2000
*)

let log_2_string_2000 = "0.69314718055994530941723212145817656807550013436025525412068000949339362196969471560586332699641868754200148102057068573368552023575813055703267075163507596193072757082837143519030703862389167347112335011536449795523912047517268157493206515552473413952588295045300709532636664265410423915781495204374043038550080194417064167151864471283996817178454695702627163106454615025720740248163777338963855069526066834113727387372292895649354702576265209885969320196505855476470330679365443254763274495125040606943814710468994650622016772042452452961268794654619316517468139267250410380254625965686914419287160829380317271436778265487756648508567407764845146443994046142260319309673540257444607030809608504748663852313818167675143866747664789088143714198549423151997354880375165861275352916610007105355824987941472950929311389715599820565439287170007218085761025236889213244971389320378439353088774825970171559107088236836275898425891853530243634214367061189236789192372314672321720534016492568727477823445353476481149418642386776774406069562657379600867076257199184734022651462837904883062033061144630073719489002743643965002580936519443041191150608094879306786515887090060520346842973619384128965255653968602219412292420757432175748909770675268711581705113700915894266547859596489065305846025866838294002283300538207400567705304678700184162404418833232798386349001563121889560650553151272199398332030751408426091479001265168243443893572472788205486271552741877243002489794540196187233980860831664811490930667519339312890431641370681397776498176974868903887789991296503619270710889264105230924783917373501229842420499568935992206602204654941510613918788574424557751020683703086661948089641218680779020818158858000168811597305618667619918739520076671921459223672060253959543654165531129517598994005600036651356756905124592682574394648316833262490180382424082423145230614096380570070255138770268178516306902551370323405380214501901537402950994226299577964742713815736380172987394070424217997226696297993931270694" ;;

(** 
log_3_string_1000
*)

let log_3_string_1000 = "1.09861228866810969139524523692252570464749055782274945173469433363749429321860896687361575481373208878797002906595786574236800422593051982105280187076727741060316276918338136717937369884436095990374257031679591152114559191775067134705494016677558022220317025294689756069010652150564286813803631737329857778236699165479213181814902003010382363012224865274819822599109745249089645805346700884596508574844411901885708764749486707961308582941160216612118400140982551439194876889367984943022557315353296853452952514592138764946859325627944165569415782723103551688661021184698904399430631382552857364668828249881368228006341439107868932514564375102044516275619349739821169415857405353617589009751222337977369696877543547951357129821770175812421223514058101632724655889372495649191852429607966842346470693772372526550820320783339280558928531468730951326064583091843974968222303257654675333118230196492752575991322178513533902374829643395025460742458249346668661218814365265654295427676105054777954229339733234" ;;

(** 
log_3_string_10000
*)

let log_3_string_10000 = "1.098612288668109691395245236922525704647490557822749451734694333637494293218608966873615754813732088787970029065957865742368004225930519821052801870767277410603162769183381367179373698844360959903742570316795911521145591917750671347054940166775580222203170252946897560690106521505642868138036317373298577782366991654792131818149020030103823630122248652748198225991097452490896458053467008845965085748444119018857087647494867079613085829411602166121184001409825514391948768893679849430225573153532968534529525145921387649468593256279441655694157827231035516886610211846989043994306313825528573646688282498813682280063414391078689325145643751020445162756193497398211694158574053536175890097512223379773696968775435479513571298217701758124212235140581016327246558893724956491918524296079668423464706937723725265508203207833392805589285314687309513260645830918439749682223032576546753331182301964927525759913221785135339023748296433950254607424582493466686612188143652656542954276761050547779542293397332340117374319397457984701855954849405947835394384101060293076229222813120748930634453402527773268562714800168187154724397820718780344467802161781584190428200767212432557380143641788768261610410168187242406879089099298742081521832375289427527325340710028357506950624039654627522443084625884508597862530832247745388850680034883243404900839900580809435652821223703887020368045486007762142440886972594135843659992262117396708049509527927143631546404446230891581853671196083703048535209096726295824150403559951213554503322417484741003319814878324525693347049499373016563366609919039571228228448816743121506285699938740388190127448395647910347728859721198506494227969857916699564185512650415021915547196658569297266065235732937368300278309217766053870304620076615849467002260117567975180039347917632778449351426349683600375578571607004981815191843734382909347466604577506592736701211153705824964798479304042058239647538578509606260933899147061201302431082605182629586400760030594943211668804461061346845339820217594325780520260799181775027010243910692395143587669430811879540483428720465590544366592304024739228642896334541485235690041651251068800831486185685040441436072326173801113961537597228330099764835398074626655782403501022068774601604941122645479016865696040761229080927136607141190032549496811699075364677964736826283289754495445523973582972436334582836717622299337436113230270179308157145770541542030095664342425586616820466432579414584930032651296138041021386726302649540031103578277761497276765658098058136362401370724686620274977917742511869327008052428001683051455997765482770310966934809077705650870196481160701720216184097320680920687344872017613908788915768752570652935655566181087947604088632902090762300448695218423336689104873753718473308241237963160575886290468860033911961086558632886045272982081970968516555608209130371584868642452279968550542907538499726386871398443018403781936509113995097094573651623752042128046884699994821635040992764497493222713617749878947846120071743875226657653773796236364909781920185222277072487814174970529693418181562505594057049606513362517985917781403983017915138144133956939851434588748354757335717230614876919807963295878592707393625350904023321032718459363314722736199744321279492915283227995224094075680189767861891815658906050098484676425943433092179052620519490902914338720188187769139434012620600007945138478401014381853422342508791237834395584027678625355553279851638657280274914867161095861536996447982339783162941046032651577436283369598396842195677484734407857599899435743854905906252404008381838089824115753082092635372708038519554651471082448006861939349060311523717360716944001624995503389855678767047655935653267606340410243871087239841244566057009531792347005418492695089943860146250496264650870819822153720137332010398812714011713754913935006121412060490458728453208454849412097187916893648636775158805690981849249508866405435338812803341955585585123602779440144157522088114397671331564942646886411137683782882559482720505905483148111686077909126569628554831675760982387244702033594275114785820606018558258920434836748855653401415972631833228456538395707181839285770330720914474542260190657280775988664109098193772324006493297960565133525118752241563517548933950627899112997244569376575605048843960052231554503351761811676489671678867157524986380552403328301563961523127449613189675958106378893315477977609594983240868614366851275846065646452697183537908380766703065740290035231111616569377072348201191671151189426004738551574625940336052570812071491742730978093570542848298158148093927046818646470772524776936424367005263567200862469394055800652675449796886312174981317852963972957649391829106339399572705644934214590945114729738095996405079314833540151633788469018180493652265231112596076274478271435151569874698270556581101266081474045406020285753009410179705660481095194540848330121471779827981324369552461074578551262669550496563470018143796028741417208367305986047005297343610263780775269993413290510675096768910218247824945536088982252378277305602587713415300369187015016238680383939273025114936872286949166199924159703462257826406363884794628635187618523997684057930021121658158188029646989597403795646404310900734613930283988594970541754893699378384542967760574412463580958073252641931380053012216480150512866170628541732614047728139020819647051774417340599670049699658289869510221335652976017609520938036836107622575448011512049865508182804438497816365774006557056680080372083489488056705382640582064061820069890587613583164381307883459622198460461250014435335235711974913240923996908662428484893224734754700730703325130946708689697010417876508112430205042332375355980157178158894492774223135039296873729303432901066677487713292535521717847907163908403243514687466730223147018838808559850979699381250495322966587813652319873825783171423954315490586417715779836742667672232879696732323472460512171331799821487465443011185170782391863270175015300389113540183885265385459078510280779344792600889342525647859805899257043157091425656761332990880382493891350146514129244521581318104020067874695033582190915174241337035559403553774639071542180085448337018268205560148573050504513266615308225857306194751072154211229340884811763833018031664103503828820817769442285991059432858079708072657797929498990115480505160028049231228958138168356638115252002937518044621332360441441052586501877580321228093816313566489054621237153103576471075158561601123159060819757413353362594505302164656409783900992825774877900267888172335529118455307615037371031211097719911450843052676550661852954818170253919573178246966434662209679897672537293040862559449029505192239584823859700679712775619173923940364068285061571730825794996043843731521860993607779875629193879946369071771807150320002421588808309527334258677118588674341476234314003379359362456182065097120979918204035974732799586082828054241171682573068136622034987171631562679038505313466685412578982830100183451930775098501407486844136176353678467529862512370000957871153547974190579110394518137271914500628406490295552902616145741050277621960019705287356954576664377109530842710243189862032518694520284786541536016389489140869905797377112444075297893220947833869727022404473640515353927919040680713151958287305316959711312971231071781435295734830460596950577753427166256783389145457361327744023445850154934497415488061429980304790076355089491390659221362772859150374529408883289364388326851929953385402351375032326065235516562833968812032247104547891987801991954428378607570771621811431123777192280467057963643657208271017525507825795282302823695221281122663496448721094197605595529615176430340980687155010432778151249554017996390675073878647860187040618871256499193911390854201451870464300482000471495175477059323357962425622360969100244382179601244101354179875092436495334185725253317109791294735085876042332036216442612922207759776772063186628445437012410676777692799204290316763958835856797804979180528441338130561221662293904932829498322522301373631381232985182673284867188482739685034141919419223252976383755423254188965772789751013941108126360672173945705406906135972907387760910473780613871562419588522911973195506746067144646102643441390163015178638562360795564629686801224053688047485415060393701838104930147298363936816405600658468607840432341337561775723276370070116251335082057045838455324543011183274043419473913040191741285623653436197958624090923492662175822734801006099450646252047686438012566010889071677478921090507578330843085946125749977308763981014656237269671195095654619784066066740803649526166324371896624998522313218449449755836639096367071683632271949368402756183092717618181528693413428391930942156753706292533166861397048998016110155893436616775189878215305569254411792665072269420567118597756319587176249878989020561237949020004786139183246526191050060746411349091559167399121745112102875021107399825655467475499178958883050027850130755578456368721377009711819046368147187303521449334160409481446080863157348449496585254873558642245236567404002759386036847953313788077286660185704758769451163550176832331136702065498802995420817369999182426652124787731285462635721427990095399261403636267596610751951182209113394309103229849610967245484005026893897306803695578259554168266985964538272152288440022993188023408058188975760000541086229193560483089382678790872378278597535453298013224476598869520538064710327195289606972654798068225316376845070742569946922910278981041568644802439693454199325076798126950723939104902930390030110549747328104903645467198219369848619525217982973832319458813432824995502272925908141792844440680411654924461035104547552854875218707888507081250889566817313589323557387643281396621160378549216252281490615053419392958782145523855856064926319591169151055377948359029654984023869375000238775742768637643499491656139936388230053450356822224059930010823088283420686445540847958909327897385686711108086286398614303380407860641820170626176610877475813244096849711870727256051243364661033999626159599284892550658640541331912874250205071206581416796" ;;

(** 
log_pi_string_20000
*)

let log_pi_string_20000 = "1.1447298858494001741434273513530587116472948129153115715136230714721377698848260797836232702754897077020098122286979891590482055279234565872790810788102868252763939142663459029024847733588699377892031196308247567940119160282172273798881265631780498236973133106950036000644054872638802232700964335049595118150662372524683433912698965797514047770385779953998258425660228485014813621791592525056707638686028076345688975051233436078143991414426429596712897781136526452345041059007160818570824981188183186897672845928110257656875172422338337189273043288217348651042761532375161028392221340143696717585616442473718780506046692056283377310133621627451589875201512996545465739691528252391695852453793594601400379956519666036538000112659858500129765699060744667455472671045084950668558743390774251341592412652317771784917799588095767880510296444750901508911403278080768337337938949488075152890091875363766086707435833345108139232535574067684327431198049633999761803046221286361595859836404758009861799938264629277646275948484896414107483132593462053635073046055030768215494444154778884559535228440047850918217255915179900785243523837112867132342905566964492585582623118824223244661476739136153339414264534600881979155478967757529878307593230499751706785370666315222134751026417324918906534257373051835228316776877311442944368108997522287634554909933469253981028398378467695079971965163008386496663274223886761392944112379606529081463545502415193643368404005225615575618053680459613160686367226297126848055518038239624057983138433955882483556816617339018195508924667782042898879384623081953507082523699065543916029676565349509487102686726405036344889957813954840804697878603723560031033518890166410542245140400821480026071893924502077785635698810693233664357379481092927781936265980614204270094398298364733767922501305495445975380037647617519082652294857728828349379913418698964043483457091550460629912859614271432256377699794328889523074041463529466113313641884192574888189320796571991444939402534883228262813008861896042574601728494994278407108181373696589489891284386732846914809414282249693998218451171607536476526647025143840576964627461240277981664136348696075178308441798271738385289245524532811319976765100788614780251246130623697946863614802966831514335653327505770397085364267332161111682089202901187498496231536915586214434877198465657601760839124393696132926119018504068128455651825287198401120334020808587399337295731636424470918610687428394203116986397891996390562362901188699470706356959897962236434586334676763282017580801821436974604703819879190531194346750475766091536825503575285762903118656991245755998628242847834299441429456077001657399257625256878727276835381048903864587835994815083410836220664379874615992147871768743695758929468720833944133793862411040279210849196558048164196011021478357692826977689634913237075717171123813776047353186149454804659651944511802211885353219069190277452743505244036660976239915385974450835787145826054073479168104385549951615634781456898285518203784570027455380339914096055716990130768668615342927218726748902019291362433013836095089663947088579450857366283443151617082358160687285532478715307016772960424864654282062742190107057721791200806754770461429571960093129777849936369869474947619807563847190110436175023704489467459042359149619250645828489069385746960678367514738899186685854156564349878614490485488564192274609731892271474363833902771602579689264738745678825138371694284573492325175093279158218630684038557653795115185593408558600172458508397041337959603933438898618095102715920082126733257464011338856514184818247527231499463070626100147739092243116777008791984106908437285446448256274188239009665602889508959509614671292294443124983624293307705662771501973240737064127640947286506924229576773168188626335675070358355030889253217173903196168740480960151471953595526004533902449030629064038374359161402779975565063784026755269495377677449729166805320732185367978928960633664461426392529896868810917999644656577708310271625301544786794334078070501034824788156714712109769109391893004674240152316572400869222649611575872389996539697825865880382822457467220374824184072670529674076831226751167437266681449613415294093835947978615846475904067459428154916078082186225405349732191397356252605823850148077229282688876699686532470494921515229271095022451830955852645006739244166699605609598058894959244497777165370559745006218280822492615634051158016874246008332950272259650647716435026473981549187001401352190883772974403559699129732122110766905581992480007641455017821339629946327951618695987201861524922677878830941797272111633957817711981154191630662331699526117648031967622662081428433850378866051446639277403596518092153382575435400711230314531397908075990687455038812012994785460232414189666518859667938132073539874423873975406098822679796091605369208667899470926533511282827718836849848599579414018106583769420230079046973223726548694221542784606218878135536142093850313644893978543237984358069565973386203315350695567189617536968790874921963780587993607950807272106519448538790925804147517270654942875415599130369097228867870382611447732133707766055078103817976664655986728743164563128363909616834552124773027387860877472236327209172067714032549614945560163741086932227164758473902574762080037840530503846892137000033951277675874189851131766149508392698666371060335746820657019903634753757736913224124432085578990378805572356297035850921840982575973374454869863296567500017879844185265797646879940222906300988206736120914409128771324900952550485038186016391050940369514892427265772484041865103740292963438250452710308355298100818533616022556145271561494565423910797537120174523011701720575823341149600872842744235860866291891510004413530634967351302486382640943833262342677358336128811472973597741137743083528222158518718413497118765091492527345136632558319683498376943232957941881896677965250311499608900494826679365759746791314125146991139414595737258970116015599260508643319491966619028249748860293906395109878016537724677001358271500153176735232374810679071290291850598535274865256293629145563945346262002567355931018968794270114132105875759686027570525120180596010258571707375893515233684369399473545419826399562813273874477619250373452299129775724013156785230705408368176248255335198513983724118590543715987610021853237671144447002111600744225235587399625156983136673643074092124684334941182620635523524743425667928104523651663315828278467558203892263510804004178980208111089505274205800213732276700479761264397363352943008539553229034241743181689421617956342266330277239848817958486961868473124957861755707802647749179747993606407241466436463527648449609847580099646533725642201098878830436852073006099963837192911607387488290662582589744403014748637161538724533961310865265740286078014546530956015462878120418726893550375006971156353627054599727633584506191524926379462437536532015810978572842701234590373770442673588206670389126770620889254776819723477272698195858117342874997802051299323649442933601972620410423620916025298750940698249017144791343142508290559160914921827359559944213575856396209063518030460771998216703335148331650062696987637667680358401618762402952169593133625735344783131677296860802415067396062250941324971420348576719689813842143664001381315330938467260424749431691892780753301808744157501146834252014716722044617495827407525466597311726948143272440589299865598085660764504259217205819291615614530303626827400839101587668868826614083908982362302826783102141846413706869361754817850646381622549215762841155267740660130145640636418747012407385877672562593467851496224075621208238023523381300713755766607266991546272641042925778790998724595865460768070745622870117320704449045565115810668841448718337476947064476532615076109073026996635413317530764644524616662473950536776853475048642295191577160237599217747774425354381512803884118722764693124008622224540478362280315334284768557713435489907879779307776245888355258186125701648610577102502691298579841073737322708208958491461505073818670301971525336536016457220247510080575824549797033198412493571890733952502272707130301193345997223389136389686763920181622122384732424066724910034692009568637794014710075774388330676189705082215252308062804005984995485407044770929617754998332605914394095401583043483886433606794348126251653349277825481592727933567390569561144992456567995073924670370552825256656679487509525439685817778976204696391462443999693680380196064640764025986032043910071049968388591627831214102854643037379783763566383006720089177947793320322780509523361198320441460116457065534824768409480810070923227055383469772274353952596065226261556210211954933086551264625085267279131291442981960774229253804934610779841833764099635625177671469131725947353443167934836690079107845629354729926004751810276782950053989872209660162280630417420442571915457459535882364547669751347559952342642858473028972801487529159020904943281568579493456876528290765991459420247883040415498370655743831586452561554369592886144743222244112234615471133076857300367947164041657468541826980809038466668838759628558474083220502531622210800418967555063755417646795394302123493247717365651723017235362021560860292743466111882221605759902116646034501336824092205103133742393062372191826334587548478011772618697325071667965774420458174796506551572354673969893182784811367816550345849272473637412814214069411133819885142371632419506193405207367185035542076048460186771406268898709335932397717483531730965206364293311667344836285666420617246392257666816933168932412565757268758905649024791465014330085502104023374113944955131738969152970999219149293645178520646503170255130045957279646684840722015962870222580213846927249605113705867498882764097744253482020803380626452443473540293212960855063864808387876166364211600882648055462904270410085986279002079455433264668931228653293592878049708448861873038854962231435414413588908932243590453571637222492135844990355063561875180664448484241933208380225223644062379231065506542487693207530463404347751284195518295879811234709442906775605516226143304625635777297865023133090966798496876546177554922004519456236525583294968559358651514909371904309587816971383324113115892245289476633038310309798746617505187412422428395135098429294070801544529388273821575528574672969662117897783630194969933642937455337310237753145193064389620896769691992786570887223161221248583905498173151424796399954118610025702671462360375048351716804391853102721207160278630406420086396055247057961195279086915098006068810172247885363092976069838781071958051417778303720603804002070987707938440885219782267040285277711151926272020455590674918258059605188444859971238302161010410520735829229328683560993702732795605827772036172606668999605754555682971064895553513143289014945212580897740302225911453849072163328065724669014101289091266667821534708341147857564358838990926670439346698311638873144870354389172958047159983531442994059230915194659176426284431141470649729831093672153703029619062043698784575969392057442868451548836303365294545427039644826100116533213676324760967878919010727860836313534749974388181555522302729651014662346549379839315060504006642302812401236611017710323624544752153593604966451203339404116569578351083414576820980221799372464270402754234644556522345548004026234500174484138273625267788606171315226697066125396683712215942405022430041661796583412765376197079014157693497313142705699873532358949500216100621905817318412225684948287047278246082409395218447117804084664316637368122927466002909503630396827253470969945894827369873915692236418057600548490834091756045072319102594431197877634741705916967319343004998741754141109482748109448534771539864024093017183401348739210444209762928991262097674195542429370918465538746121083803507579267914058233667189804462203670765482793447789006397426247471584915429632372742821387129012652187759825036872574500023359414725774116114868889775858438324085902639994528571956751817750481225814380622785795442162374474180753048926445976148344838512346918064979272432892531563058032618543606102588576921398414288181484287790688137855185020166072383822303874568825217233041779789628750475911710250849762905673038696469488371870705468862832858385557240880397493612871928979792992062085274205943980884448086675937104090728865347976540691286161595051864436444819725049994700393571888218558514163962510824365726255499058534926465965451673738101516191797868154257522465093302729421954470930501708667353446172899115474228552319524067359145864269821855500033934201495679870932718165572574358209842123263593696987983084944037981474910093308605874776875095022350390824208258506639064980325769614395705903987537646691436073478123716972147891253206032038267772005059600025289463519225074464397189029893732512351880650813255483912642010060924619027845944766107664537255318233626929967191786272333017671830055563309729598841449528219152470593811975348998746800336752469120190862388566648479629571835967139473888704169950453477813348602629003590009585809569255303819714736599533579577484516429971762823873725781966400727017696692679345676706670804937565993941989012525639167829528809184420079911867139757430378536698250873856977470238046040221020595104991982535918048268786850327935603588107401442996032301264448373714954776525556241026435330901896325483416095480262341433811491727956351311719606771674735086511337691501055196973828425114588408517163041998979648105723018148056217616938816393935888748539264505601441820167575824476733823598866602697950672963642609740792313876948043560678157338667032466043019146924817998161690141397052356394875158153978933633611899274031694225431680477348783060000067996802904881588611911505512138889538896381069630523627449111158520629192478706799969643738016073412840704813840523854097744319994035771019691433109430254936559541272131741294622075574509795357737032945527844278403521047293774770530042932215140669662390112708451127231570476412851705436373235365612251614621204898064587120621481634418755468678943368945109111959074132644239014992062197630386445469965347121650538024238908600308642785667004742065720297771499725873241864131314698186964558607075803300885168392369253398719508036210543305312140666961165304124222429101165214559458973973353918733228475556046365004320412803263863614471616609931895242227902990992828492506645938755384638690294527609067948755298366704258338606425990059250304870609090683795566049505372189650491056666534236868016719233468769659304156233648587865136106942107798713624381245646149123181278303780184643695335506469762366616120070001018540730263519051732386075837670263516224831897028120084352695918113819017666358093429882267798241364327791173770458922889953540029641894810736082279249343290021699556433658791256050102380118778793089547159934982475732020839447143483643541083237461492678999619256995978844057160955892963395996159588592419049246932789838629662205456526610829744318684228705537508104400156483649557745269092428779324249815734089892637806786144201726189468731484213256277547252477830562855522819954877829614719969491765355073326822296576611897705177112695824757000169495299043986613156960025909595461285707012154498270190138743882314895979719578108931849944021487533814746652567806499945289151281932215710554951702291591117803547162686271448317457301949606777970173146884255441871712486135210935824353888402069474458501497413149059410878062532102424392851294976370329228273122548709993391047746257496264295733379053883877340817370437628718100545077203213007605830734787755838261185893515003855702333035631095468581216044075160401580685635291128296279468665652419375300393619281226127078449570628196093373902938559914991383459731753506942688437889419736011399103163179544854260013411078094418397067594948400290748021001214962594183539170201977947079919171321098172108341844716811589782073282108881119575901757375726601834339340382232559573610996744436960734365490266660833802426614697640870990071989318973694007128715730466122725507616021074161676713931378343399343802609776415860429903326916665142085353943148805425337450572271025524811935639358104493611197875463779149516355228677967394466381498353503869330121601333315249171751236547388643294852604932937730611544454500138549632904815849599412181617370777326858915075402716432426371456163846239098865750684201933825500393373024080492483224588588658958522148579303349137516128124895616258153117288344353673417158083033224673395361203627949695118246865793419122478375639757864080487248583764421073542383523616779176230219241841972942307657481225811823165375275343317242431063819273193320787384653844432561596388378845011200639351291512007477183565408599839897422761119368659182993441859439739751987523013841671098863130981455864095088704610019439470987789080586869714503686718567308048331591528981937432179464301404544658357287210207951524740213493874025031220971216932589209232275341974064834639553222768500360833912489734368535096709690586878876448325609603688053951688762672322328706436131847402340427680276619490195481096317380797298320900507321819327195253343425445035088139170429567120614885952027375137264438172737287456485128402679357939388940077801670246997832028377295096900263846586683246450446165673402978172793898962767978331629988365763156746518532166216360244012107868633305312160406021082886695904128872965728925766809224930692207570376955823041434836434052221512838790043781031249722758217252024497988372833681282728786079020648143285904476767479406911702498030958947654550242336105274403244932599236918831456651633623949974355902083921749611345239791816500685193220929401337908827962552820266344158743401986455804021514709372168196975012798846124781364711110371718935121976027531963305678151463573956988192777937992038946390286559554333727724942147508689227409764662953870657241967079810181783008253675484860218773879541758730404970840394105634701726373022954100290942570599907146597282703577336799097759178349071098495004445119535050820083841698817456571373039419242554807980385285933646056705169102420679112805881204607816152198597706683801478663951802374351462640672287814327640951053577029253021219172888843519021029055073280619087044043390314745141497623759891527900491665493696185028298659974168596767862652517130437624403732004446566106421245208735520057671862641097478210982794070402917732361781872367734384704403946501663175906776201033467616698376937746758684632051864455483914596099986146288641054563758835834586003808008759613490042533845778298474082116599051459098043682187833105959167207874350898371836280067828259798336817701247997715739619978004809999534923036140416306716042469711482115776478414811465689612212712483827368468613314575075404590254502990502859740104583288176161830332680558442758368120792422957598775012059804462946514111860206973669804745128455585823818110059280141022961708495933589310634080617667729446003242975041271046903970462158519689842837838088407625536400407074222566324783192030826205708046792725143839262622348223623562149129862403484195234855706526926796817912301068385419475295818326910336402459984598919516509924234327691416165439859397219424496364970036002970586665707059523672804883987788522250871415254274529329499418697601508593685741891455814856389152636206961220830577705028643882467181014389519483751262955542559733417264950490211824899716508537794403797756422593317063172279568439338142053456000719293873554252103919716902555833941960495560540012154317332029382973921012449650760000242003943997545888132719094140109860877503176816585537499126118712525974797669431332247210263178987084846269227748568107159173075615716686727193788119766387291855285171592615596597529045169275246370552457193824394873087638966209224567329114203538112964452302954488032336527712297266719871148417322353104294796329289176429007555667002848854107039669411435228817955335039971113650858051307544688490623025521464540605759199855720334622553375500455039668534321423142641480192950872241081929737112225873927130761657555710305640137395851996625316413496510668741133783042721771279054598829565775362969572338332079568952796480234379840086266738" ;;

(** 
log_5_string_10000
*)

let log_5_string_10000 = "1.609437912434100374600759333226187639525601354268517721912647891474178987707657764630133878093179610799966303021715562899724005229324676199633616617463705727552179637497183245653492856202341525057270155193600879777389725688193540712766154731221809527948521292821358059722567672285287240461589448178364671328673998424637759593189423843934353451050975054454194740501365987087867383213130572972040659485383838723662753876545562718161511659930915243207364911677863900675872585778766391583836823950425487956239484031001982697117490993741498480957621016911014378862403354321512723125734588461559787291980886570684020066599844472699973217681186517601220202978408109019647526699765068920658978913381571716207227774559770534320387787496829375361133800946764048330285002174774879708007143465616359897041258901337641524017005888598734948487787971054314178320201453062090615788790671598125167499041434172122036944700092685593759785492118961786432875876848322058355961996791316696509323388531585398982370985431463110075882948144753148961789112201485955185183682437986283806689420037862023016071979496152137581996402203356064097272841563815449980030196573468023267862396832250990910096416809997055753167206826150961522206057966833044251673080143789092160550680008032623194994632414766151744774061636230434657898965661012245518259802869660116405129201442580200794467473588631763257434369029415038732658034480062532002011778286053275520475019193321327014575865262613990587916605172464900220068729341544616818570048196544058546905220674574253474675124122696287440808175207310687989167880503330590796271009021553318448275112818945570078255178281216239024333433998226351216947736631312351775823518432616893515545492673573673891698797401844737438605841090793408970744261746339721869769918286761621943380662388928991523440149929851435707480601883820172903384162368564274215722892362702875174267945594570538459660274071655407902759786273677533949685486999716692023361423270822254797026705954132203032071431253435353675104807226092095221385032752245487865799801983140159415963767677395941229894734000865163687222427173533084730577789843941196856855259252798445183897075701106249982935335107177079108048350072908913748141800244372760823198857160075469606444263551419007241368439203865138384615595367655467932700750721467260511381793770500156636114190410069652558760654812175115565971405482216228699957770952279984818137464079843066896981051701792926845732891676849174881988364265626268243308223292662579847231182747630161567637598816993175884996151970005974516156508995440772725768595268909187823117356271163321166289297061644766264490054777532717575014156717106654132757591543868001400010518015311600780745233706273034718757441792705405802824706035510853705574149584186772346613593364998240252175863050995323277677485608038016900232043150970308535185177448945525626389288533288291742696514411813228075328102276868483975022815997557692682741047767433344425686423052740671757812783918584440087486525721251529327095602476502865335741302846780497576558649846533869091817129904899584139590538413167401655486363855297635281303265830694582919080365502513695675220273795527349940800225933055524725888600674702239258997797685257168489595499278118265217490186415932468998027935113581968917762020324927959483150965655300114269393534108455233678968061158543702682305923360857035024972217758707652240242913245013317426082373752187189323465170357765938618707876773535522117633365232657008099218191442771231932816105084752358919774331963890487041926526481237257948043372464789662785606657536613841726142632496013363456803678798135144410060069173427908622211583195838824298898943413733634339415895688953121950273149327586436988730824320396324726172593417210313287890902162340206984084964422267516219111929043379627782013047780163901792589977008342755984742947683961368514669849343272551395770422562082010154758862053887844352619696232799653095852195976611999629667035996506232022041203513038417168235507636886752715829546142752384095568339917419092486989229416872882641618386203153883227001183835477163539050082439441873676492579168915748744443157673880090946942123920401313643693619276285229892387398862482799577648176815364274180683415353726034700702950040897660829376356934048937498101059839091487874278310600639154750726845970542096906533110565806327380183647598840892542567339100802627058200707787264792275682256190256205686915648156139985527076785416475053628903145358328078111057172949021435945028191946976585443279512229759322532590563941355079832021472087110064830100708773163990215965976782263564166550059909116685919703320113772400101369557656649902278221825622572735047612087981060075845837274892201642405846771828801777656219252477340552513695531862089492087063428831932233974280618152004145618777724266568858388400511067822309741413533251418560619717032620490605171373945355831772679916451535556366073716149077781831100353584166910767868507371807995223691883785373464938647695614150939741796370342877151072792160686573470628958516266781913504964102353287127226827818747935910668579080611383609147482083972118932860755203788544440599374023166257320831813706381020328281142347488887145036442484597814306618423626957777246479057018018553748898788358828124809697436554788288242050687739945633368517346148105470488797011347435648238653780028107479678003492705696375650833668940335082626916920091091804420292454401812147835131358244908351462369286669507720735051280150623823111348475498022447673881638676085400332376605291882178743134161428358293243729020198031124949100923168551325471844429024280312300883510508558874308971946729441365022825647173902797777652042995829488095772298629912364506326903909163242703584009199764908911556977537028232580654387102460146209123647789813019191825427901287699376959319884640561069033176688556013194956655972471665109588401128336541554497469697653836623673683814920723910623937970603094007512849381397606056949864960485567359894845508980331828026916551890675205400774446152309827180317275381051293302036423872514922037425296256512899253003100363800227091390827562271920462365036791933258754758160767845136402462910437390860977719506249471054825169644559904367436686874505157274184761021384269953494588897867945511379688066512149052261221194088135743001801526035383649208502259421031823711340405253342484949382076394504652989693435591823144192100485639076846458630431167248454204251218347723693942909112857303367170815754217286845018545015525936993547104299192558918130086100800955137775843428099096866902502242677785363536820912386329078145196338039451350825157970547554029915766398018611161708926832127279100794279422345511028881663598258943141656444711353420712973055287858570998572237096311279588705697276786126337456842513310148370219405089593665467874329385021660480298267729291315082120705805092055477310673399754964666471244472586151426016463298039228659249702950494140316464815942317856599991514557819513414085480530636532388158620109488231591396410921973395090593933972423235972905877929741499846496294425190775862799133926684003225053362848758529009846543916820712738642357200326748742798909754315911597270121171503844483489741591812722645911138410887709691326381776980494160871738855969768391114913934375039029529977930163162102285786089862386768757974308219586832534979409923791237234887297773525138105283245236204824364305322778473253155819031657121902324463465428647375318761913641657664512373268379487260193719157506380723298591591420623268375160775274891754652867174419543021889452656010990590119067161045460400306748407643657667616812576971330717824811129989820560134890586280652735582174586637287343876081924298928393042732157563472894427893066441459328692038497637665038249288502294670655269182053984104087179810557713889080103047772338831715500312620013370121441028849875641474189241954111727954137960719312412890434220604802872750570440013146861720491970750073366179963802146851716275111127242132569627730549215226295527357385739192315794981206811984031836156349450029249929679051041704173511201771530968580975572008636974818566946454961872773633334310558037610154893166291016722358249810322382717241066275007097432849330192463021974014401030487083171193940607230153706294185473900962290178041636690417473464421946569570028280284073352672876720851986803445977074619937599451760946921186574039473001697151901167732652269518305374200125019110743582285441776862581090581719074417605000325701715795533804651355469230580124994961415919180773382505774877088877305017014937426982104272343857605449729287765833889227712711409263310634198277696965322589218104023634097081116476506144208004684961017686866795791746290170266169705438040901262701413223947495502548307526812095519163730808158350923735822219707734187177078573994480257716070533326143333078741881844450126236086578246233562500668615466683643668543930774498584468099587256400781712634804148429798545350544517657977271901605450534260939833278067750202922439749504440964919818197576513971843621755376370496655506967973378059560946078527783119272216735317383515757485748272337189833352294869771255309055623319644780309373159076278668727647238323466340904396866674405913276964162624564563972464827953877368675299891891069236128863325805682191700644913675987145170931124730569785816830702190390544430732711366821167003804201949734684423370603361884590817211353081271869105248645433934299861420017076791188942187298393421889548402009250938864194108036631261184452723729097210865454448770357299193167581611487783000359360169740719354723441341872891988938644177198306949668505077656837125960017177702447643302036780605094362674401851005310721002814284053743853331649635816255205367223174784269733111276315487808069558534731014698137170353714299100783900808956095141318773006787579411332176117581398644524599730765051911020684225420224174849756205330412667546398015241018248902788463324823458915360708937254519283181557444295466147824616315090426993624742698638081709053478813694759806559612478605982460208813487700953403582183278" ;;

(** 
log_2pi_string_10000
*)

let log_2pi_string_10000 = "1.837877066409345483560659472811235279722794947275566825634303080965531391854520795389486597271908395244011293249268674892733725763681587144311751830445362787207121485094717338092791811982761611260326469746189254749251036503389908954820191718702783963223196261148010695390772129917984462427911385548699942200567039196638985062788541292591372948823124952426097473630568998758688764660797025895309314563863475975706171378846272564307946167205295058530982980078711199999207412694370514404715243070068724759205431697500972271907684962658358248539992275367928030278957545910020206641768393671238815951433252541175050764972451860505904216099036240393610451960091761077149767065888227813615655553475444507626676518790148280405238678742633740894413711891568698265520815908260153679609403505177496187717491144646506687784893855965574993705422516175162331748750580176968966183507788152591908819896935796078324261814465702873572907512475942070869085263475575292344072228345275359376791323805401488260958228279997692576121781272357409154809008885920001372178067177494924161775959043856937286573853455451085829016615618954429728550161748905717125145796637645242326423421182783027527934577410107456623593982993146110392038472104350074745319857029802662286495588203640681156140581237697382543711885995973566462854510693113218300113863946539230605079535181679253381966329853477988403603702047813560643649647729902760400209201250612335342585290274969401419199555927941333987586703313447923188408445330946360799714858479017355534702630257102402226120663431482590858428792379743240482595047354949247659956091543641566690027172652224310870776290719189918740628183667139729657979994697403222622584248301203448844432695628662149690723162448636883977750965081836042581027974668711832373630168253372715602999379885836839890359819181795471423281950247930084533167033310013707066390297482833702105050897096857727848154354986940846459691572124451904326336914088615942390978791326576621290548806020361441324466207216468262138988236633430097643991052608221127485840264629253430105690807037478266530377725563163283413895011589926081283571898213747773396405975955183299983637742610340405409215289646503366541414457975883180453801445665052201745571883486299148137602553290726799243128830880610309931472081983476079988632196022202550504105511454898337831723828926726324903257367219669670496787317694346997818705577524090477253384499345149294205144864594707983987047242925265589641736265079795475822359442762844591922223543974558217544439447272434953447753976899228747654470245088500538558398366971136508014779115992909920638320655807476482521191988726277342544788167184620254424743055299577609934234118121892763388494198021267266354320073727147901844744219773073562946798041599754252812540428247000076231137748048034133973182676089446410408210967142473332101756966722046380140252286021777161619500810493876097469561941458529557377113386034691460591312375375469235900455441402379934302906788444868311239916955844515178706375710553438030102090439043264378633643065500088117436776030150563779261558255973255958025133478880635689071160416356508124186708801415983341386502229642106525502106568887907446659795486940803279444340384619547257572780839982990368175828521668242173174766220292283869761776191846017223860495585540948098430910620394128381605417817223624366591096612202596815757459117061821814707119636972749621060929483862196308647340865019091028291870761220570144803023064779354610681883755804358826236161509204906486535670326235367917169442600877184343116003631946618314447975073188850605512625878656765082757675331745655955086965601943001711683401265049870673638675565642352774668282588791820626269679707113564701747997923279587379544616706618473554440349024845752469023833962386220768996963864920510676043704802861406228473693854225769052146302852022385237703087939474195606638663172487117159891985151136681922815255749651908729419235506749855702931280625010890435436159373483790335930361025756537189489939137759827376924267188244034407657935557023987512577015433236155143438548321523906996746591944110162565636628410178462790369754891482939179775342990235392399630672118279890065895219285800559657638036046897525637661544478573915299380201976531807313695849096513001173109260483983762478416251043714817754695269311337588185342175487418720214159322152884519485314989602779511034292211798209320079847139359971820195709671007199704736968458182485776235026696311307889986392818290854553794444329199371738597472323230693684798248848654793207734084932486564699133729833278337192975669276809313109796549417758033240388982180292892823720985494161518146572030327597042685748587404103973313566108749545578820856963891254461163042412561980628007148482698312625048958810062487765902681001440673970561071820765219713637600554162656280114366932946315512141102701596811841263295322187024972770450706068925540881221819371250385450947798734081479641677396683458793620086527294111700033635150124916447136958825199374692462939600104907481991845661676519482548052687322170868201445559029136222127660764308366357032666035679965919325786168998488599342918550861503747043619892743923541171110651844260190337501746790962207901924571423949887799809920041402729683748512103398354025131999999434218349293574032478095530263255908888123613618711880754248952885561468129597352611460667630617344616103069419473038181193771327494231942034186965917174754294465496615955790397071035259074090362058068333071099737766745276042254812930102681761329457210203131803493382917181930785771266825337723265720961092471026273658225390320405968679967794782983611466251295274652058830370965060710406936070731619222185956612584785124681898783751485274126695035595530634294811388714364283742723270997413543680252523203850694629715192036403259516135175236794233751717562566665837542093085670428077288663238646317168812911888838842207804455522892535455959835407372202267079020463613256570861163553603540351098396066963833984772049167276452247378901773079528570387868394406667195613410191837192632379411596113137321736021871870453154951147644963513381965771425069345256116044194021802367451683855249451043378868976822853804700786219856479341429693388336302923794641516613573617641985251186522317076932509618108656972004735809425588028621426852075553520529408706556305388396106774232610899644343445922036804307481667337702187394659653350184275269216014257081091558535603629661703364242747963229926611001149433213244604023932439959414554286546793259650081389104331466028877768865948580450771095476598061523595295501119388216384211289330418604662902200231455869499674971074152454135646236817241151596957177915149355863673088122357302198650651418209589759106077314027259334614854010879723294149461196731541953745791110451465204368379093635660657519144909188110903001165658267078777837043055287472865259539598644324978184301964580086074699468847933095073212721948781801068551971480283477626092048618967242726083868491524345590482536424357992236742658504211633958175269173952921918764693478977619953581000126781313529055834767031556449008761113697634805086246052264677041901366967212926796314114028279539404224395157794200484609123285395668016366488065588899719186751080575121594274313268715585302889659985325779700181103615478759754306335424955009635251414511828644441122536253306183112105927500360857965623046803691874893955544063269162576005418329222240294852091027043911678192119315075426391706980086940441033345060686089812081047458649131788007581774376019210266406312717941681821548713024836850797412662003436360390562402206517353324179210922217393025503289384496299226727704885306045691889401611843138945901801240060981514492526978111992271822983164038860054889466672370245642445702767296505994542790213019359687941873710979402152764780675875074749177440986258943837120888588506555569236310058634244913662055652913083042441830809445887023136951322713917505931931373290849751162973995541044998377075853398646707149010705078753908372227610778241203592103415467815267389870661091650258369146006612610518474747111253234095781735399641743600209541282368190409642751489875141047683098250798626247719700460668152317810483140634546468522689890525775033825564461273243390960773580261577054431072669267195745890265291772591044723826000069554067823936605694723468200357093095037564212413533830700157955211828786824078894513819650211336693287527634628716058619084661061639111222234715331894677326080396597251082803447325625880910229817023914097535128402224257875668081347037627985951454730547360821442953318999890174794585678465119043915939065986530241680612503933542297730347043111892185090919874087381218708174415252672682600727343961237201757976649312324606630710223002490356226139524041386067395595603871839598464073050910040177277991255593092490156498991059932042404492955188171393355292913021074776160140333731320386077209850414282135862933315435224061860398312709027168091788886343919140331752452902791603906635672845787018695895890371620947780734959347240966340373798418504986900273405427434395522874872438548023828056237908947401335697914532541435511314429645142737365411653262342718661642065044574027421290861375253653404889619547057319814066306200122883010838854183904783985364412061342628181780360314277030343226634779901696525164266473489881282103014087964721740146528027052357899354456320710683845666300236404175120109144693057440519588757737441474280311853605858201586745339796491572565263580543742671469018274160104125394313241822633854993989919502552101290669288246632527670442112563464355348925564723820908226826739111767551140341070832086331584802674849867848869839382448413792124660402834020462358541898683267762495750023648884163767901844958021613183532799139127254664231358123023612113053862125863375496425609778762646220744770598585924448310236512583683559895686706527455975978778542781668000278951017377402351128994756502770801873158479941063364730113191485598226391598941436104101852270880734598347949675564811674022588211770622394190973693032535630863220687588170" ;;

(** 
log_10_string_2000
*)

let log_10_string_2000 = "2.3025850929940456840179914546843642076011014886287729760333279009675726096773524802359972050895982983419677840422862486334095254650828067566662873690987816894829072083255546808437998948262331985283935053089653777326288461633662222876982198867465436674744042432743651550489343149393914796194044002221051017141748003688084012647080685567743216228355220114804663715659121373450747856947683463616792101806445070648000277502684916746550586856935673420670581136429224554405758925724208241314695689016758940256776311356919292033376587141660230105703089634572075440370847469940168269282808481184289314848524948644871927809676271275775397027668605952496716674183485704422507197965004714951050492214776567636938662976979522110718264549734772662425709429322582798502585509785265383207606726317164309505995087807523710333101197857547331541421808427543863591778117054309827482385045648019095610299291824318237525357709750539565187697510374970888692180205189339507238539205144634197265287286965110862571492198849978748873771345686209167058498078280597511938544450099781311469159346662410718466923101075984383191912922307925037472986509290098803919417026544168163357275557031515961135648465461908970428197633658369837163289821744073660091621778505417792763677311450417821376601110107310423978325218948988175979217986663943195239368559164471182467532456309125287783309636042629821530408745609277607266413547875766162629265682987049579549139549180492090694385807900327630179415031178668620924085379498612649334793548717374516758095370882810674524401058924449764796860751202757241818749893959716431055188481952883307466993178146349300003212003277656541304726218839705967944579434683432183953044148448037013057536742621536755798147704580314136377932362915601281853364984669422614652064599420729171193706024449293580370077189810973625332245483669885055282859661928050984471751985036666808749704969822732202448233430971691111368135884186965493237149969419796878030088504089796185987565798948364452120436982164152929878117" ;;

(** 
log_2_over_log_10_string_2000
*)

let log_2_over_log_10_string_2000 = "0.30102999566398119521373889472449302676818988146210854131042746112710818927442450948692725211818617204068447719143099537909476788113352350599969233370469557506450296425419340266181973431160294350118390289817858261715443953186192904635388469952023931084961246254040026331259462147884584731828267268398232619654279350763131754835092713896494691778576891805079000759954808781545971458503196487762612249229082911819095149899717161986047767650006782051791255732862866834200040292050983708457222489549429756214970724465970861368960922190948276121439149652823516782649231480402774624324416331153873825930388303938063321613023905188058213191568546169290530150513192698537848841871832006575356946839297174213201090589689085058562464098721839687664853985623516127730263892787826084983668103030843141556081394361767454885666342453812373393242246959434906021204450429682746068847854611568476841064379795004659699177456575408640184640794565295443410774082939997454007372170168019488905548569106940037541168996341575929721806443038102815203392388085633198685453987393548560657842896848982613944260846632782952602876621276230434192202628912112083612600558368625489999909279487843197474433888686291177131574131432228241690729958547252661570168378653248437724845014942310709810575476442391111669469145546531582130875457148591552640646694593973872746626264815563731353272693379596968024623637358037017027865278713823682667495198288846233675574623064477933647769803714706831332588818731312138647402960387841835706778409896729322309228363640902016770371618273369284540872180801447717626255069534761608867969624937665753204434486879532892939253551114683172522672690275744806780237681755348374057043821812232253331678962079755990322930597596747208666484230417392379259986253497978309395579390585310379752521430687788055906173448921911090260258267733075735592578884228777929210367534078634908553047948919541274191849959984720028965124825229007476444632358842089065039549599585584910351150484927218240498074544155997149894779" ;;

(** 
log_3_over_log_2_string_10000
*)

let log_3_over_log_2_string_10000 = "1.584962500721156181453738943947816508759814407692481060455752654541098227794358562522280474918088242090980662475059167343717552441060924822142083950621698299493657592238585234441582536302747685306978051687599554473726683462461236424885004758181067696131640480713082323328126244524867063389801483723423578366247839011897700646631263422336334182127010609804917747254135733011049902626881825170357699471215711363891249413575219299869904076708153950540448836005036823127541914749100173257866898925697744774938240861996356515529792799178520148475921953751611260057205378865301368537607619852674211740645714106517320212929718267594624358613647592456614519222929865095039800290148414062008287445756365962569287774257128655714001940735904419351063914850646445892620141295451107262912153161635024716679077098150798550672110502830157461363502940951119999928752025961894232434884619348797477141547653036143135868896572513619819412535909301087103904710344934206366206140177236758403446844855333343475173007139775657792454932949910964696371080950050863848257095917990862253163547676740698611387915214383237422959966918230499548626212216882244111202641955726169009400362470025118471622528421444895700929266974409224156493703957655036944696673923007689336938755132095944690576217145742670010948132605238289629033283571918617841038192415016059175727473766864623591719260506625660235491700101955670919943402510693642247143218800071915643492701681750841469307500737715328781939427124230678576498155297586493646514312571710693077323100566677236224478219524831804175639806234142986409012749174121555149415021863444261301891368290290466567550735539445324968340954096889765013430029602723405295743795020129250763056821530366455580699089420891050529844008125587117632377353523953838615218297309245132266791393711987046322830579665680476893538514451545660729824841889789879070553259667496444951250200022198697309733730655879811191795011545912319710694062765814055484567730923356600775117439001217699981201817002981890010109369894805483610160336847414828962737175082083710975146153789347759025888598950667071165794790323114195320428229764402176466879059765724638368185678335658418148450044558073116864690421803852187740992890978461281791564326189620797846370342276117383918234594755527494771460602747044387886589268385988165400880876777552749291556314405931901651822175093264288482751105584661962396345624829297545961790246542836059420620223188775112284516815591651371157572236385568713166459603010722557447280570155694157408598626902893624225176959201207097499216983887609612949891486531148914777509790587970777304772871288483145484809448197241687058562870864543657274000719529118958974216773240875462168558705910605184106898855889297812880851021498540959828566266675613210281193846702555841571877237397366313527533520415879816742550876655942377933283069786453029471552025086901509640462109626265309141887435047092249454774440782691504262590934757782442342694489404775178506362112582034803396610730008786370612061450575339487937372702145930491296966380037074439985262860929612949042594483914896749120494144663695983231993034999498237799556602979197133199749787778800479255452847102931481118624937773367865595272392468069602615920499198656817080566788059594086047970272586340212249933928252087123965715956885925988405309394097062274540289632402028800287073823676387344285977698664796437458758011107787095278842928090697269407691992084989887845819558120874360366895421147511674067721350805958345535659066592518078877560301316388381504633260492859820495671224671103069992707583244243866122060360860602771119003686520517330347709443541697436771931824974605066483921198663599809830174871028321215814965552044677824055541899592220892008302967039038578114754314312935765343076397983761409571635990340398771281035007148840347565916849475605575803695598048527681940443976535177939260281864880745989619567132735640284584382191630351620377278753729322037518248204392771022660988455302602014647827057993513935206746737531067570897494539544832391872891173758974576658559383340353644461931518226781856510867910694122985680486060392521142283183367808765717664947492152113603413314242217174594896515639518293323084646261802493607514533972163913217090018972872927686657373514474947226029916587737321480614084432330704497626955462200852044712670604662916204892352386662467615997997993260733224493138598326190556073949589503296591915116291998594321054944968598838225333384546515146222476308294902425989547300656508612093003107530042890086574054467191204157221545399837024747341532729786716275887592275717947433836985824689776977973705269751011420841841255167054048329644913802004345180140205619223047614770116135500655426585092593067578107123471557478953098852039708170494435941351175295506331077071020555297459716335197476260297719940639324081793449505206952431172046654879521449298691169889452823070198801521408413510082495940124325641202821913189731216417758508232888764286974108539632299253521928967713328371625076274927283941371676871544127738659969528162904452086995045162846864074823307577160354953101878463225819593121904636138889356675808022440145253399886689555406525469036071054224618604168957703915443513154865715529693451070871628003588078849754484654021921569410719252885720033968053808383721767569506543432834149167881676034003143878280068474154278852885788575416567827667526050117648683388243009604808052966077277021070866753090611110897649679832170994654436742756468106256042279585517572792491886787893536656556744755727693669294075057825741874832386356764967287700964253328547946244776786373322144779674146780551091844700771245452029081490684147819022910080384603290368569237086788239923178956367636239830426806962242769213744433441461042444164923823279318636857829177511842935181272402919633647965783870393483731591391979007803557719337534070104822934992296067941856214483570469123433988951769770194998116481506094157535492040737213953457322831655989944174377213421653142667471183796843021485399662996749001418566046219156268643660467818888595335289168724212479128561357546876474743252394610248942821653252706129430725866481723375800425742313974173634902916652791550375883722545180010689105266702919507071417291598357311140364998879796355885817828216451272596543575262312464222157122178135337909038689069062222676048366233434263942985986601433958769882243540219304614227880434017006869146764767843877452861818986665728908406202332838198769175608661904491782505540033762395172658996546632332496485259044219074294623517203757479237137028679768878249246791175504259818893818453698505349866380300062533135491566161819839054039589778999799865050456659179169941508112902860101036784635642886747201768800776209218770302495618779119520887918261314081395154599938680729554893458683800943600900724177315437335242885094957493353984792163504738215611764982521578167187682161806563015313809947648047553532248481281034778584421186759103998898690986134211462779504774689536675060880974360890974339373868213748878699152863078093842096528610997660911354955388822450554595771715096196043508792383299229286603956700384907561012800452721359648777524094348516461590510663707118907721895459595094011912355362990706212576044684510040105127556318269440748001352292991590786232551431108604452423248304756272021571691912575884037183633237566777447256606697830711872104302450819556063508604620937885372267993062111051394504161961458871821337823395112993902016820249360323517945458431380608721343011799983961849768475352446249320837597111409056555400407814809958245071923675166833788449826821251661767604591772703207946294604194010477965868858279306071176698111651040904938839420379440627947030562815702043728441974292425795649084858682521531377434993615528541979182227498920475591133378201674740520674339088850699637482905281855688115458679132217942696086596142395844518873242856862604669131067370606622955154189800341950561702160161648160452777868907133885127105044486044265344961003571730724726590409209655673340791866478683862212565745720043516596746631778921679628458437008616070989911996404139643378320912094342482737038505003856708077560079656575523984531669691495054235826234105428311956748218114201269403818972859046464122978036711570254580226284506733700255157580442085155226628056814210709199237429656670549987965985659325312117782265192810038413714085742983005985664919339724427608076566679924886976089555279055466647624509104942158109449800075628393133473073144298671964341716124821572504178800069638064753902455238562885085611318788337358211452325051837049287607340807840835188249936576478423745665494790702684219943627583347918092737164055539558848165541137508346429887166376014663164393170399269504929811285224827659228903194986022683294798177195433787854033046317020653892380492353345491650451338681419893082532603002018408890883101979025661927847692488621248260600583949463717566427822163789329735337404185250963418702023370259916330889319490944783021853024207070391082934724594754906310669272401999916800403455691820502411973483678190020997415560191558674039179193790691320988311830213011061466928639902480711072236221073801870674569455837439443125376288525141891783412971618820446115512247892176919377325298048627464361069604811082512099395298098544396293607127583481692908393048280570551307199092705568557432052106533886708096281236587598040302270174405913016820468210667459196240277553799964173288633283036717680350689650490926553233672485437077353966484082899873792635060662683198868718949614376444526491363524962227949809876035038481259787246808355089669561262822545971664136861471929810786352514042622672842572490962223641002007377705129718099879066576288632849643578229236093131517872589300674141987519694393052587726132988196197422142076969777197524681167466018995355805382178783469930038711780102290961575910319302078202402985111106897599625052155690497542797334208011795689029882495226881353405806887433385267546869260270124060587041812207610547777620997328405823034313940589105390082066477928505360321507039762246696838596" ;;

(** 
log_4_over_log_3_string_10000
*)

let log_4_over_log_3_string_10000 = "1.261859507142914874199054228685521708599171280263760855741309887677370402761829610122345377098903491122708031876627430389846898293872950827372392786699900071933281169486623354904431225192399703737345585708681699062162417683875218580368371918764437406164057971585137581802626265515437564979509795228760093987247323071540303159165164406238432170538497215697711884401908327288487894188184430791934599025894063232803598326330111321565389398215678672433940966485603393868166178724258198993744864137621117066529036447939350243402291602738272047275237480896568489361869436181434646568385408203359699524040120901630615882784740549926108297267510926117500502065098304915529944288637865147061767177150990357399220927768017319179104341379523743492273145739313055259583614450823678059350477240545136142088987088352071464883689157702031008619538859879555597996037489946515915911871237116710850370869974397643175368555451267849081682628085057057009029463420769592660850062358146517634491364184406318527205090934888928772457961719746496097552284188829620172546689207998134218142176756638209916874776010122532257669231807409974421872717656300951179690948043032833596777411161739954377710988284995954089691578534739196988460369346698860587185616786541530310951043270531320391652475151663275845008839374401776716993233349884748345635045870089010773766641129928241865828905809993504272555602501912877995748958363909165173597113962146703773650537862559506106443844619430239321193977807009994654595681703929973052940751778816473001067936888334114786627477358730161412219548140550451433914973719282850850507129839471140652878777070974713328235483859068644684817800874803026345693591998836986430799074577411928315222136389497511327762877189537381365003359377484451196045217658627904748753298434589527890893587691834758292469955565301413390571800427357453707091398880417197280470178068585813715482968686173008670647164319703059771094757563234556146568054069784761464912556864841260000357528811448990417516359154628202337215596861110283039861286990716316585836298960354214814099872670942960460854645900178435720785808745127188502940587808376309407763344122927640852022761137596318818883744917750660290773199852764121577077046762707116769841076570779655215565215667254871804342063031884615878963365402395009336144838705942822526329042593086707396276727299346831785136595051201483815958737961575771791056157357185716713472139746799901604806409655123800184667158945505586185983877337556556821592971427209398118668244808460932929618471223811736204723899294142693974989065110526384201282434884800129677423150671119104849954008983170444558517656010164338103858610338630393409257198538356386557375366600700783317283018384007051017728839675820661652986906420022302449900425902918440291802475893661003826296823964755203747867805460015610004997375278267042818707447894101043778521453049834805680268904840015395813708928569076066848207167612350935538405635796125473518339895363180632938448003117852009304605726996552717352407613923961809642775008546254941551823452861400396109960002949750125345223300796267646826558647629467735390933865585870692408865389700847670023987583183593707849024026630869309311232266388611778796848697808909939326938159496171085787580304593519039213291970783185077997189988580509784638434058152534547837407496354275678209871988805777090121778070004092059817576853543436985285829085446262377527030167396588063702945042772267913466445794863656474784659657617003800131973728733069868658560674490758278833021393748665933137821038970315287473922143130135469038004056781938377558703724009585761705659873618157990904216464557853001834695998130084522019673872499047118430280745656444625864220890679690839858355940277618283527107341519790765030288167562206215532491720379186485160719252618370840326785164820269500704421087090266127078974437463654314831034443117866637840040479785488246256567145093657235709756237755803665430601972285559534379224511410548703281059055393632737092996093291147436176470115726582516662046256863414604861958106203408211154949367472842643467165586100479054066336194250914198883972892945334815087361150670278648571110381192871266772550349536773441817030550430023314587934515707239270751940076000851079226476750862341701422246583398876032169755726643347168361560347154996171522509601166513682210210934922674724503626938935333466197279571739034407646541560632697822295256693712287912216293894182393074408384595211813642516332656554458478704678122267345792355438860913678101936013621173494187560380425965027157494405726233012113306026035754485323793196914912204950136581403466570264992969563352116434444730364061471116982787200597830966592443456519887422775394732598388629260624804965141344430048176349868487103934519515604100296242184581813417890285520438438118477061277063998437540842750987217674839095779970717717714279944113732264077941595554928133215730756564836246914476226580937291893922031894775052624771361764409016312549667425640006458160800736615240734322335074314958727743654966582027952044920311409713109164174910448786500044205702482059029122934185316027133058855156797942554431267777882729018324792465910135977653269466456360743373994002796272461133755774589358880421793960559074272458506085952317483188865423220767845856400847943436819643553454796129634592329263029717182481884968079582070129458445808738356802320052881711940028053160995652232197804258483390055313010557263633695240556247059395580867365935401523077947562176919547048555902840718569329311286963862949826431313445865885712483188825017223837391568127880943682315761573685717100355046956233157460714414319203720145321566524607035697982549674262335468496235468455837626084275965075593889106196935208121067089746579603134678045581759366390340561479634304203654840325013472407656744498250387688719896423068210365696102453668836671607378951218083455456939864825189281125268068702529030532080524213675959491323148450365711671512119732941772793373689588691043822676827958330853350283207516107236487881451263872140115293307181598211753180489541861288245415564545772727480232259011358463392876769658227206157824996005422922439317565061178920893644135118095205172876719591424390152630736744439599174209745058011251052028247344279846563902682619998159735268748729363240076095331133549185653352356707679553945362043072728322606097715808455285192891224148438584323568630316049374716332831945975580916999853803419199094358473526605331335794394547757072750949911067652945572130707840078061496901603582869956391035867441583937635083025948725179686497513680095751872179622576595412910706659356621939928908890407695115710867639901133435582437932768998766751139792687031264174738523999699571453454446640516898330132543358866284621576891576591627262918588631313424642403655052122811356613793758373743785481458249535214545658085308618451354079739349365987254172929486656889584763344480039402194980203896930527676561470261691313224886212288026058779298361983505218927412105167410919939167894174307517675135500156875603427276126159719379749901536454776634094619736967272955691512591997720424459124108249490708483791560098020384233393749379877349729970071706812729183989652184552372608218413268182538275606890567672951596435149049561655796370294640045175767268916433257329016647486281881778639739040126572937243184434140226132915913456355906403267070071300207161774203361660492730915600823221560080091973658727112300606210637882379998802254842289407827550453978194472147930279178928823697385552428196643662818736842470050818341398264558654205617556790534477859305131251021724948489011342874473801508527603992227315594345874669449417188757576553611258702296844429316234551254380681131399776529999082626961154852651124319667667078488319832869107788210932269200623363869895043975855283862962000522924940096515192393060352861692338947993750065304054079960812192999529675252521998088963906603893883269643819430903821744936381439281924261626687792641027315020998042668690349419718558547710361467649275502086965407786480815184987799145870253457520315936348550099769565410515094364429974874125966260262518190286695269838407943877111708408142956320399517260627580610443493863876361411177226643140075682044891332085960120281419209872491699073297196434024844777367981865971965895801289023981135287280137584721451303698330412693893262711630902459941191744507981400199669338978699191565059353826872768682473300518352550366678692889776357301281554868908405497063455331472944188888352436332474804368783880263346316461013910681892269727334638090967392195895392030215083079413879015430061838544821012554900720455205453230296458130640179603598871946533683778729615772967225528501778926001969379357411245905539281179211709251479806142658370984608796301018981514474213197227932148949441049099832635240271324341299698095382542874966973110663153119586686595593578027991607429736227632747496049938466125309867223908522893026307111786533212481641240156549224751901162655916353794897312639431203651775760374771556181050301899348999874350846038138530243768662484918593436076606552971255362787866386728359024151858977097344257990008681307068820020107078143273063306677868852400195471530547714733569218564709514288099498458645242119357753674453927921685670649941410766014419417215477451954977154076626027181153260948566024921162599146527342714100801068979965563270879117821249742255856381195145277208072256797623987163495021879761798788194640191515397101006428065779756142371419482312720297195494117896088385094770788513300190679745564732967647175715680262209256093507151039962425703248984658084999668156398909925807547054464313097694885570003142822912045626637767618050823407097959778194076400565835064670469314274018812329117176154837356072113697743134861566957185395547072288903187621415823819708751206425189688825069684441595865734417095192221648889521421984141387044273198894334513617821839903405050843398146758779761967622098777964272473503731828281598510266207343145033536496067958296213740297323221813413585663989084712981290895430533169733201835032923165760505" ;;

(** 
log_log_2_string_10000
*)

let log_log_2_string_10000 = "-0.3665129205816643270124391582326694694542634478371052630536777136705616153193527385494558228566989083583025230453648347655663425171940646634814655030562792138730255618922699717672286041800832613019942189532855463393890461583132806371040809369384417114396747846899170526422674184027391035004631190422189323680484095772276875435803559664871149188455813202333163965976808249936452933584668462357426343756525369861095695215917735720106501342222449994153507078142297833029637774311970293974350362633156244687655088608994135490709908943039494582566844946811522717063194325489044697564936223469819270466722804100902961886880218201749101992361055490535324877585339998097074377916278218193441996319021050429330124241505927926809754056140292099176158224802342090188412736812269321284034933052507728909167575791393588626671908786468115956639594429979580206395481395923027937867469315592027193309322415124007731716247058993690703827533513739231800701041955722130456332586628947326070184882339110039410732806653401499469573021082748274189715287525393030688138907291395201128442083034323850486685736587860119046528434794198195953852751607571488478774527071251753614918471155537458093350147634485568982235732421883055798689110808355103517542657369836126432202634311529959422788036217875632103923840147531164141939188855029906339219401978638069971546406724252094912002426654995443624946685816004098159421743688538651202160407226942418148300091568730516438769473728190193591694140848003578290735348830761118550100061744132071865360868126797741042644580817949484700438450400933040553514061477514503804830361476363031847935967381422323090211810780017727426421081865612296918736911868938205053604239426981556017752534917114213285594903410055388379589832791801026009401433332528385969940812371186007428422684704134504934578923587412008594907362687189357310911084836317952691707769508506692371369624305886208680561302896532604801612735091002094496562954956001844738723845666846699883068337347849243093105237522400789272950881983399560626485597556530684155313141973221204280935472780076639086083244777078590970107631442115470388375054605087652954405830283216011027889175204721738267493087001943532779840270667435777382261988039042562389330695067036671815503556253698690840494354079013704483235714247232538202926702159975727994273515229887016161221678177497201677838174991019950418264953720051153697923213995894279091993642874291335210857091044259552568296990551905681579242524785012805725428822286349762180821230379648979582441891140813254042422059230656153739371129953926208563298423866201353275151400811396779429460362558082097821256878821902418184871587317937569826601021081498574692091391754790489089206761673115055955602541395591658359842361712524823994995670576952489716308959240544599670770308218267282361533338927356595391081340287706575637784319259642475705285623631600422761894032802172131307940801717423447976842366792086625211997299816706466238292535020984242199053334437046786349337077626672946145772875042955305481834844711355052534469652208203078113580506068986539159705495776089521500057120208442005815791855363353531156837489240498206479769632796649697705711943843616571907494899968528155809858404802785622961248816026276034675531773215462462902395147604353754053441530223861253342152720179035410527052175099339328592067108093966928808275128124366385586424645123685133564072434688157299421087776785050615290916056772844919065069634367218115959891243467126784350058201388662093412985888755150186547923009405178410867951760553649403222645775117626859095859879347832672335083909023947224452814947116992311692300170962036748883947548072346791200800285225201100117531253568760989324583419995512584189403300571216362584292121817293198605808676693943424714148077567451042219263767010695301205665885391213173315618274150967692215599897852835194292759828302093161613268351477371423282076035947839004296610365498824729936029757006726095868229950539894365410072832383645167655343981564282952024675189999127059352907483200407885835489909769555128290690389990928624277707253174222366933190327831035334055283694674059207499900736864856271057924140250236342258938603889291162435489203300375152420465029757981130362686460792322704464543203625575967393123019319068652084640051212355272141946013867154714612381444016492698228681177894543243949089235333495412156111958434320010990907612848710751046669232708604949476550352145788558116667676477972766889908132846233070464886135098371070938480333598031845276315155585039152286205070614420021841960092748096335696666946034964222973644946302836789601266982811534698818789585271528090875501814095395945430313760655702019306169995112446082963466875860839760874207550877309477350556786906673001442499009540707652777871816550833107364186548203448633286354230186295500712063599567989286561510727917835798490850306608979312950716937412506432273720207911991095227868788938985537065879521709551455142111331700004816624770859826089051545506672683728664517032567045617898725397492867668399503460592419911456011908396520531140552821777670331019774841531642973408700921179418323722971040947674041454376145709466686881347727767694070913943253316737179270389596713457135565547700879456704652235746033887081003324906084656670580942630506610715279325216975754299211172733996310228012512382036236972036992821894265176555333098137782763150477389714426378323981092354026272281772581220456585343715178024550575344736574943151820648329937772365852563221841444072049270660055625343030034233734990078479919792840636603734624536628359521798432110442306507424668288141073806064913111714514555364152908495540318918192765040096950617302549648696958598543382892832178141608740600795818854042803031120626422176947349839830736042016952817409357863138418012188811174589915753129947677706420395014574500855618533755064890814584897336685316325587929864354667236283925119739796860996180063708781152135452706725210730208075107824927728469878832610195679811440199777124040543730780484895446928688920794758796397661848662405272298419210372235438612645969393463926051632612139111826475724685512933658116091043929979422240953033325272139946578718636998110406737295206044121547975104971202544864741210401906355000547409222591638499131279777215090842996096865430483150760905963890829359282637495197508604638926878690881554558640883747723342902130689796824370575703163490508278276085772127551909078735823428716465221351788485860949357509164876595226021002866625858478145629039041268819809780843998075275586853978228765696309552970223228950626521237753744721922675595244272525009755664478498576291421943994272923061063606737340044552463907915089585833925497834012411984488500309612622925952477818791628194122798019641931192141878561663438768526326448279665111225514738643812693654208090277352446141819005347427945583746807856129521369219083043946584201927694124294219379593564500878499885835605953918141444840399491990527280052764715403819198820201222088692337808812664778620455826060554838317345838894218050870112453211225195102024697856122209994208973866568714624351290454514802877424382229560489218316704599291210053206705014316727485302338441719186784937157576630136258677939337193849806540548905135796861006774735909796275221325876010928296341170363590685530832280350887375540978805719891414349483999327675127490422590597551038402366670943653753424441154338545192829122894461070210563742990519068824975931108429513561932842439911210729496622323995980846706238857893757710351066827087252458127838501852009408074637706006520394753249581403304228925337284557113426751463685794319119756513841449431947582238978069433515278114129196501024317215004763627575930230092239968506673792640947675656808575040129509857164828822778823892809934335835354990049017678888545716920391689997403378321615056859484873054956453909223326024198920779719652047538737958370003822917649498753866938024330753267883121581641645539042901491654633497879009517915649322041607366154753687505181804578569981754377282493973873400515295750954083803780476709847051314274184776870614326908400063843842783611506104253264182157456336274749187367546637999310459516050099631568247487714927114625923296919477225989248228786115070599330672740857827400551401039100707572625940430065588464624516963583125458608926168496742447213698697428108280779175352284999291980862417896357375811907288138673004054925722529532524045560678850887182798302072148022689412221960407115051870011625113867407999906992651140441675218132114985525894608948954994696150963493700982408424899206991923614386444784268664333869270931689016239507737160989870280979056483429342544769940899049516655025277083021277018573435366507060113959957692198761574326677568503276683307334922968983843941851014347808548239766226480404273470027370337728724919783784186217014748864717199599542858654751274790305318545029880274790491838036099405450352154661738481332980896201384020881865378743964927490759034862243524608658796953402806321636688230514831932157709194575976132499916770271744933355348343115196720726285973663477927166274394103244092478494972103787798125103201184439974768995644811312427674860358081618348914660162184288109485519742057838186506486089099350233990020687275144202948870988806484779202667367029063796501647225934602318969329853407503759180548556410834332382342701556326794941735702591587051580562337996929239605883289198989603985404343990692602889646504081158737756869849580363647041661828013705016358877986015708896911522878899029422846896714265703447377621283016771915190567205157407964686454144449856936798268607980154301863833396321128703793293081671729073699701659688468077734725077314481853967782369554045988314675518522435024217192020011127326277812944862579021036952225943131684834788610615338716308090172062665251193183538003904380897201669948938768640212814567344941287970569448967514322679231280295628629838992138105774485395497284972726790673391368419665053940931109172569845343413655625508284952470734611683458088011024283144424433238197604742018172667940239398192051104221" ;;

(** 
square_log_2_string_10000
*)

let square_log_2_string_10000 = "0.4804530139182014246671025263266649717305529515945455868668641336236653822598344721999482634439269909327155976613588974812551284133582685031775552948808442908391846647988964043352524236736436580928812308860296391128071530318266176379609867308270245310592522665631282002495697645143530796306408290554829856757231497851015586791084960839091519331108487062405284543418244549279672571695295257711235965735880104133548647497043526869238858333882816648790885754097509664972315805078673197345061447120050934145165121186210920350874820298557869127160923642986717330184462456328175964108192663586577823392369742800142655279688239795869908197129189382069993082583934323346415434096631987336898095416909688384466947545510583407805548040262172357730576288976544334408005854897596221411999519227087945494681391370023493264935098635699946010886029890064546561937821041079497876045774538834358268120607449944156917133815839074252478944581517394861426860297536496899453356522918217388871690526612820701060119167739725540248075624884101753375011466779380744152205150773728875630010649519556609598281985319771842723320435865358267303081992527355028278247583597502105120215692569580729311471956132348037732528929713771673390298024085028066165820016120890247453445640802070839156446639407425178225823739267306639334908863094147219514202338958674568715580444915835783650341099538954979076676883225017623059751739367747115971944147908395346663790205713500647173822177100365626275052472574012518113352041392749311416799058119415821963413173755055149774071686195113245914516743082422689292038048355754475140405046102991509233608314620782460820117740527153038641404751059643213880197344184795622091040349244198142091749286546642869521872787306946299178259653570311196274601389066273869307209563792345963696332854486472271394462906401071448451758512311868558727302531155132483885917596172142957810270517880370077424948214435008154790272400384973537223416903478993263216525595358007945280670548514934692045579482865283954243760294940088369712583704552761032906992916179953777398364909565613436537073954829365664868145893902065250065860652952564938205718063092184927443323225364851819598263218284593942640398532387160573272958535997035634321621065325688357777540148437619829046594462068834251239980111073511446124246266447223790152932055853162920977086879350033758913137205190710141622257180227954147851914528811964024842370832370194756899041556240443532775561134465096244099228445016948533608693901025567920461775070667282567193985309134319613188887332333887934281621961682566798802409070832754339146832627941092488868252845170576010744827383503111667289366032418972762841182085284946107038086134602364452664805358203981712515045841083922746372605164455234398391650088420478838062331601375973425207546110402450763909302024889740614900689477651178422960506245466522171808550698453703396933583550305357247849671540544335535025731399948129235883396002182116194728146760098948898059363195756857610625492806009609491151360918527177709796807882519361552618653597322697919534124580587385867139627546460547776874795162670736277680686854167480043842388092096705747219565630787655561442496724120476681438090972980957698890133990935509967554927228685182731516485306005782786632228230879262716553501918395980366434220145222638262728645935443572859259175109935625214560121146176849986521213526369692898326441883799589810183758622808458789668837070970709438990942314407797573167255198299319147404712512079427225769563225031370252746440551250740805269411306327662645584919805631614387265325341689283291481340479036647143832827735000966832020173408966713928198168620046291946537657992084821389529100087191274598464086006672147267105746657100090536857513217610693742960806643723621789913877104843489282556323430228359929205603910370935282745712380081954371201559635476359227422586878541368365114584929060024137769029578684865372362674113876989264515108754674890130550514390625238577844061799080747636373053624551345367305182969302297047499920588165566198134295449795297010345296309592540430853197798404886790163957288358075760665813371103298787599759803543048897024315180673101789867303948406714820526405207562034118551314108927448970935771570141015142704207497556848825945998115817488175869995104113707388481333235432037070877747654102982685417232731328642409590431254980746995613246736111237853456013933181731431826374204385873090515711820302312366691263480929122830565562211080065047784498374084056164770050733527713407260497539884352586454433826274363049769559830217876040795906096550212232990159535264183780417276877879203784610538936502651048381928490511012403006904677304789120936494088325542171620656224200456170700452592165029127384904870484579266484769678013924493413150843721309225346404362155354751198218369421498798941305401723715283611407890274722143525338513426858911805320283100509499594265132468416202441587099305804235158697874796509696468225674081752192035706352908529606228496839737861496971933507931120458999937843298978812816213248921687426875817440602291937478114052280549626753884671746170737719531102263425307839205767271077304572706918441450973805464725199733766450565825484266178445793278243471376285842492135851914486777518127243938602516537921002159249383852516757658033654823834960988240869619001144619254566086317949898400335435493557829285392068081537017021358263088541565183904384642427473229042841047378809335076889678444131047412135424029622640856000773081631470349484388048727412425407668590728691168457396350982451815404401800788036369683005045740837595482227064983952812088841480549200073252916415832152120410896188844911790732098199220029223118771200700821294874573171499047850825249960117334800511224695490513006299829883193595163567638174231666770481375199807381093846734373252610999804952928460077476648602503694607065526778369729768558725026969490529823398563082431764165593535171438677267335621576962060948164281589078432737345948341929608989886601170092163602065327648757771420753313494254165888370531460210008092071807831675436478259303466303372439405215782586092591392806452537140519362364478327999461398482274109121207216839585262439449044449013102175384820978571833750003420438099829140716787367312383398519008180184686601972865810107243390692139795417904570521507462509829812632255834499449747368842221217180431427004524911037903186270453335085548946974776454518530303991754770392080841417802725731669067934012747253298896777487836333134126060177438270707125693460426919220595459194699113905680029333918901660980883119118183445777499944803689640463133066553357214948046771375712672215321242067435785012973898770967484835326940535941775039276951941766423657423177400732043381909243840337909641095393172768760232054455306401378628230686749195282831581722755589374910102784920248236780318425713009838002852520825776606639464759627014507934739874576833444532579315957144718945022136347507317059761724972183676497695124298651449560151331238283748742889301695615522069738439570387596047601739135496594052574214320833236574304067459022499961921625798487359242007957029148584527621023572303909426140695155003578567360056499616034712815200984461096421698116996516497349514629276921320110884193171540077691879110650119520200017717092757018229777293433621468742002284046912581006798953519415164750407964753228495045566766799745145595778069778734207002681431272566525539826714470898610916758356327202781256881126208274721440264264199919295070889863580964352848943539065493721317280892760613342668539274812076871741433584619232068119143323302853925262347801005705193373123142779228212278952024796017430492149289344953363542365998717339747528145707715920558051935998541693039152895855718252449589395331178054326093102220452452031740432472978538914908404764119116735836774290705208851812371983893479764517108246937588621425957018614575527267373979479024366110379181956508986544450208014095467463936803826439867796300235858073592267262507975120412971069066148142724781714676528417089117518874895764707327407111729604971108421807690902895918090448266165198787586239393919564097048122361336363446399152334231393538843588042691514233641934544947385068659598227967329162419419760124104712810003612459577989361143088285183566110354149395908295601725371658998715944442855892842872708923421380535928558970458979666795194065279351034167843874596504328693333252244366482019064545030961741718607847580058341654289699019314147723599171229364472761673859217434277523274597934243354219498720217346233163890956700415945485842544370821997775683549151910012893638511008423300110375523240585618614114817582499162590968565607478504980160258183121022864370351540457924695177706363037382887517631311218281823995899160923840046497658312430190332949454064500797989941807183583459464261309708704448846870189027071565565727554809892155905107492811187834882817066309144211377172827709512679070997582146007860657713892534370001828861351708393421055838733745398259183777925401192794692015776481502426273993519153699256778891784347466595247472120553668158231082330932491723051908873626604828188181313781373374243754824534934337420898213597228023085395155101356305323275342389955637610099411663635941342953668071869744356689542160440344021752491892054899710672158967836210848662666439558471886585993817637577019725986835233306126677917921215044958280037798097554027590417222264950543804728585438353675275962775051757131583057455517898714292678648105049032713843598386295454925062099236710372087627159230969793811749203180526941826254488676201091572439216641902348479818788356245055620876564144359662026640739773019447694841539180281144960932829716617892297297269059152034636584526015921919700567490019087840156433373450685553904177188097332424411022881826025924119438644744585678082246264387947792923914467697393958897574291499412864631982971233049137834747373000596738859457439000042512831397010438649198309746905106874115213279598571897521732108382718514739091845503873056340182687602167397380994643606449727319386109570072823677294698727" ;;

(** 
golden_string_1000
*)

let golden_string_1000 = "1.61803398874989484820458683436563811772030917980576286213544862270526046281890244970720720418939113748475408807538689175212663386222353693179318006076672635443338908659593958290563832266131992829026788067520876689250171169620703222104321626954862629631361443814975870122034080588795445474924618569536486444924104432077134494704956584678850987433944221254487706647809158846074998871240076521705751797883416625624940758906970400028121042762177111777805315317141011704666599146697987317613560067087480710131795236894275219484353056783002287856997829778347845878228911097625003026961561700250464338243776486102838312683303724292675263116533924731671112115881863851331620384005222165791286675294654906811317159934323597349498509040947621322298101726107059611645629909816290555208524790352406020172799747175342777592778625619432082750513121815628551222480939471234145170223735805772786160086883829523045926478780178899219902707769038953219681986151437803149974110692608867429622675756052317277752035361393621" ;;

(** 
golden_string_14930
*)

let golden_string_14930 = "1.6180339887498948482045868343656381177203091798057628621354486227052604628189024497072072041893911374847540880753868917521266338622235369317931800607667263544333890865959395829056383226613199282902678806752087668925017116962070322210432162695486262963136144381497587012203408058879544547492461856953648644492410443207713449470495658467885098743394422125448770664780915884607499887124007652170575179788341662562494075890697040002812104276217711177780531531714101170466659914669798731761356006708748071013179523689427521948435305678300228785699782977834784587822891109762500302696156170025046433824377648610283831268330372429267526311653392473167111211588186385133162038400522216579128667529465490681131715993432359734949850904094762132229810172610705961164562990981629055520852479035240602017279974717534277759277862561943208275051312181562855122248093947123414517022373580577278616008688382952304592647878017889921990270776903895321968198615143780314997411069260886742962267575605231727775203536139362107673893764556060605921658946675955190040055590895022953094231248235521221241544400647034056573479766397239494994658457887303962309037503399385621024236902513868041457799569812244574717803417312645322041639723213404444948730231541767689375210306873788034417009395440962795589867872320951242689355730970450959568440175551988192180206405290551893494759260073485228210108819464454422231889131929468962200230144377026992300780308526118075451928877050210968424936271359251876077788466583615023891349333312231053392321362431926372891067050339928226526355620902979864247275977256550861548754357482647181414512700060238901620777322449943530889990950168032811219432048196438767586331479857191139781539780747615077221175082694586393204565209896985556781410696837288405874610337810544439094368358358138113116899385557697548414914453415091295407005019477548616307542264172939468036731980586183391832859913039607201445595044977921207612478564591616083705949878600697018940988640076443617093341727091914336501371576601148038143062623805143211734815100559013456101180079050638142152709308588092875703450507808145458819906336129827981411745339273120809289727922213298064294687824274874017450554067787570832373109759151177629784432847479081765180977872684161176325038612112914368343767023503711163307258698832587103363222381098090121101989917684149175123313401527338438372345009347860497929459915822012581045982309255287212413704361491020547185549611808764265765110605458814756044317847985845397312863016254487611485202170644041116607669505977578325703951108782308271064789390211156910392768384538633332156582965977310343603232254574363720412440640888267375843395367959312322134373209957498894699565647360072959998391288103197426312517971414320123112795518947781726914158911779919564812558001845506563295285985910009086218029775637892599916499464281930222935523466747593269516542140210913630181947227078901220872873617073486499981562554728113734798716569527489008144384053274837813782466917444229634914708157007352545707089772675469343822619546861533120953357923801460927351021011919021836067509730895752895774681422954339438549315533963038072916917584610146099505506480367930414723657203986007355076090231731250161320484358364817704848181099160244252327167219018933459637860878752870173935930301335901123710239171265904702634940283076687674363865132710628032317406931733448234356453185058135310854973335075996677871244905836367541328908624063245639535721252426117027802865604323494283730172557440583727826799603173936401328762770124367983114464369476705312724924104716700138247831286565064934341803900410178053395058772458665575522939158239708417729833728231152569260929959422400005606266786743579239724540848176519734362652689448885527202747787473359835367277614075917120513269344837529916499809360246178442675727767900191919070380522046123248239132610432719168451230602362789354543246176997575368904176365025478513824631465833638337602357789926729886321618583959036399818384582764491245980937043055559613797343261348304949496868108953569634828178128862536460842033946538194419457142666823718394918323709085748502665680398974406621053603064002608171126659954199368731609457228881092077882277203636684481532561728411769097926666552238468831137185299192163190520156863122282071559987646842355205928537175780765605036773130975191223973887224682580571597445740484298780735221598426676625780770620194304005425501583125030175340941171910192989038447250332988024501436796844169479595453045910313811621870456799786636617460595700034459701135251813460065655352034788811741499412748264152135567763940390710387088182338068033500380468001748082205910968442026446402187705340100318028816644153091393948156403192822785482414510503188825189970074862287942155895742820216657062188090578088050324676991297287210387073697406435667458920258656573978560859566534107035997832044633634648548949766388535104552729824229069984885369682804645974576265143435905093832124374333387051665714900590710567024887985804371815126100440381488040725244061642902247822715272411208506578883871249363510680636516674322232776775579739927037623191470473239551206070550399208844260370879084333426183841359707816482955371432196118950379771463000755597537957035522714493191321725564401283091805045008992187051211860693357315389593507903007367270233141653204234015537414426871540551164796114332302485440409406911456139873026039518281680344825254326738575900560432024537271929124864581333441698529939135747869895798643949802304711696715736228391201812731291658995275991922031837235682727938563733126547998591246327503006059256745497943508811929505685493259355318729141801136412187470752628106869830135760524719445593219553596104528303148839117693011965858343144248948985655842508341094295027719758335224429125736493807541711373924376014350682987849327129975122868819604983577515877178041069713196675347719479226365190163397712847390793361111914089983056033610609871717830554354035608952929081846414371392943781356048203894791257450770755751030024207266290018090422934249425906066614133228722698069014599451199547801639915141261252572828066433126165746938819510644216738718000110042184830258091654338374923641183888564685143150063731904295148146942431460895254707203740556691306922099080481945297511065046428105417755259095187131888359147659960413179602094153085855332387725380232727632977372143127968216716234421183201802881412747443168847218459392781435474099999072233203059262976611238327983316988253931262006503702884478286669404473079471047612558658375298623625099982323359715507233838332440815257781933642626304330265895817080045127887311593558774721725649470005163667257715392098409503274511215368730091219962952276591316370939686072713426926231547533043799331658110736964314217197943405639155121081081362626888569748068060116918941750272298741586991791453499462444194012197858601373660828690722365147713912687420966513787562059185432888834174292090156313328319357562208971376563097850156315498245644586542479293572282875060848145335135218172958793299117100324762220521946451053624505129884308713444395072442673514628617991832336459836963763272257569159723954383052086647474238151107927349483695239647926899369832491799950278950006045966131346336302494995148080532901790297518251587504900743518798351183603272277260171740453557165885557829729106195819351710554825793070910057635869901929721799516873117556314448564810022001425454055429273458837116020994794572082378043687189448056368918258024449963187834202749101533579107273362532890693347412380222201162627711930854485029541913200400999865566651775664095365619789781838045103035651013158945890287186108690589394713680148457001836649564720329433437429894642741255143590584348409195487015236140317391390361644019845505104912116979200120199960506994966403035086369290394100701945053201623487276323273244943963048089055425137972331475185207091025063685981679530481810073942453170023880475983432345041425843140636127210960228242337822809027976596077710849391517488731687771352239009117117350918600654620099024975852779254278165970383495058010626155333691093784659771052975022317307412177834418941184596586102980187787427445638669661277245038458605264151030408982577775447411533207640758816775149755380471162966777100587664615954967769270549623939857092550702740699781408431249653630718665337180605874224259816530705257383454157705429216299811491750861131176577317209561565647869547448927132060806354577946241453106698374211379816896382353330447788316933972872891810366408326985698825443851667586228993069643468489751484087903964760420361020602171739447026348763365439319522907738361673898117812424836557810503416945156362604300366574310847665487778012857792364541852244723617137422925584159313561286637167032807217155339264632573067306391085410886808574283858828060230334140855039097353872613451196292641599521278931135443146015273090255382710432596622674390374556361228613907831943357059003814870089866131539819585744233044197085669672229314273074138488278897558886079973870447020316683485694199096548029824931981765792682985562972301068277723516274078380743187782731821191969528005160879157212882633796823127256287000150018292975772999357909491964076344286157571354442789838304045470271019458004258202120234458063034503365814721854920367998997293535391968121331951653797453991114942444518303385884129040181781882137600665928494136775431745160540938711036871521164040582193447120448277596054169486453987832626954801391501903899593130670318661670663719640256928671388714663118919268568269199527645799771827875946096161721886810945465157886912241060981419726861925547878992631535947292282508054251690681401078179602188533076230556381631640192245450325765673925997651753080142716071430871886285983603746505713420467008343275423027704779331118366690323288530687387990713590074030490745988951364768760867844323824821893061757031956380323081971936356727419643872625870615433072963703812751517040600505759488272385634515639052657710426459476040556950959840888903762079956638801786185591594411172509231327977113803294376547509016516949650991607383393771583323024570194834740007043761867199848340163182600846261965628464911822568885752134637549025418083382138352224525872678937950537591560357945469850910225622545500301757104946983348354532383526078709221930458178230601237075328067836854130658463678886643348624936801019878279963067025954326513780600738639290856483087415761874189734584845014188976529341101372215864355991552711362332200352667785915989023144616332102651966590763206152438374761904953158296883626504209484010565458913062982771724980964195947234046511041982134768935401803825695495628603924426415986748598228006035386283916620125282660749330619658496519997941939322601723571073364253708303301143362498575363597042444647599899995085504135497755858593457659092653330725277541675843146693676780617035012003844874883823376034407751594778122188307090008738662736209166079905022698927032189976037950989059108591039296734561461070030458192127389259926961062116764364243835014102040863214991781529796815223798322427375365700855346997965541385905032683616022278847554706269843910885210302076860470680455684656049168649886061622295232390709809262930233795648217998163264582788887767452084637197106347892310667546935504761519778169902588184040792751090182448278705250597698375351430622445090220238243982312550584162320718831930069360646468209659500654929010971618652636721610741713618377667332797562685480124565768279031760394655539452314338756773034979157858859101166374845567584795271391860878254010423332985744274711896961048512640197504359909207662155899866073683762318835884508129295011466535482817144846405686524654090781547161962578446957526256945516560151916402921798854890937328031465192224759003096571549050536104377686877261915952844920464786897347370859841384513162119297201263424077369454598186502965923353451256845497454112981973587667072860161605620423063606613028149677344579773775055756466547525632264817711699785708712283154310456912326250349768115245217449739613674882204648051968875434196951193312045021605142938484475452382127014383095785581361967830231068508084587695205905329468338490471209916255636503400343967082893369836742300157511738515126912306617227641442160751291734187471431509324192491416096999867281582385925735982389484927491964615227227333874631213843626211637946706203263022505548958057308375046129923113629917306948940734258831948399927416395098443963405763528471756276219278652253960872013108048640653439616887545253426309896951761901977096319225870934216595597447175015753837674152228057065028068314335652491719973335840306415355075911597426436648284662813680217450590970589460274429263222221545945075804657120606863990430823693969320823749076756119017156130542481331171524256847846336377001520441791650116823257523616049574970639082244344451035121904881983027600176680985096524543900719909803499302686067552387968529219473239335237008665022140746455403722234348167574937314464092837900653919677401035586193618156683661686489239555496145282647289499416061580304586789146197172815545110005666054249969197410279874059327643495371452516769462069859788094695017473022841427571887194092120913799405943037050436483860043464522799330292390186592268987499211325656055784014233542605895105620369072028939315920440476835927636479960059640486076198915929819495087878602766345990540426377004590080327943472062982544525635647954299248819864613617131448577346995347557715549138423928940175403413997384616948129347924223460974301962752301382860722449638095383840152656781976450758854785515549234523478164603306293884200995080326014091830257438577067102522724366690598890854501557075423031666592472352892470258862479488754625276572728515111287827067345431024451523345654228431103967952829625019369893998347396176398809573541526014537296468147382184360052109947211941659149471670520379225520963364584846804144778030216472862399926404836350877374782450163820089524032253437992579012926564015553775409175170441962728503912669595666487724296766036730345366873404907914188694521471582790815723396912403998586939085517307980195554612851340891206108401221361707057043006056924685591646883477332085689141267942844804138468281325692914816010978627269686686737391711893146226913489458042778989960814470952476290501926031164920686774331866154696689660182266357878875060885624356267893279735463390418210877463803921624477202567269959639182468778845549717903851583920474831990312762243706623509251877543414010711233586590774812206376345901988422547272765529050439950252444039113658267081330058058820946031020826134136912757293699289302996173089284367031523858975398738893680744152637379424050644876417176861355234326986572897046306918017427797217388985944328485205725758833756382015054672065167425268189485167332804630764781329313260289322936604521021318981298766152624448748669389040617846991666541748508459797014617821584501491957210982508923451747451225432738681972586494458808377139868506598408545773165416917406705211194916" ;;

(** 
golden_string_20000
*)

let golden_string_20000 = "1.6180339887498948482045868343656381177203091798057628621354486227052604628189024497072072041893911374847540880753868917521266338622235369317931800607667263544333890865959395829056383226613199282902678806752087668925017116962070322210432162695486262963136144381497587012203408058879544547492461856953648644492410443207713449470495658467885098743394422125448770664780915884607499887124007652170575179788341662562494075890697040002812104276217711177780531531714101170466659914669798731761356006708748071013179523689427521948435305678300228785699782977834784587822891109762500302696156170025046433824377648610283831268330372429267526311653392473167111211588186385133162038400522216579128667529465490681131715993432359734949850904094762132229810172610705961164562990981629055520852479035240602017279974717534277759277862561943208275051312181562855122248093947123414517022373580577278616008688382952304592647878017889921990270776903895321968198615143780314997411069260886742962267575605231727775203536139362107673893764556060605921658946675955190040055590895022953094231248235521221241544400647034056573479766397239494994658457887303962309037503399385621024236902513868041457799569812244574717803417312645322041639723213404444948730231541767689375210306873788034417009395440962795589867872320951242689355730970450959568440175551988192180206405290551893494759260073485228210108819464454422231889131929468962200230144377026992300780308526118075451928877050210968424936271359251876077788466583615023891349333312231053392321362431926372891067050339928226526355620902979864247275977256550861548754357482647181414512700060238901620777322449943530889990950168032811219432048196438767586331479857191139781539780747615077221175082694586393204565209896985556781410696837288405874610337810544439094368358358138113116899385557697548414914453415091295407005019477548616307542264172939468036731980586183391832859913039607201445595044977921207612478564591616083705949878600697018940988640076443617093341727091914336501371576601148038143062623805143211734815100559013456101180079050638142152709308588092875703450507808145458819906336129827981411745339273120809289727922213298064294687824274874017450554067787570832373109759151177629784432847479081765180977872684161176325038612112914368343767023503711163307258698832587103363222381098090121101989917684149175123313401527338438372345009347860497929459915822012581045982309255287212413704361491020547185549611808764265765110605458814756044317847985845397312863016254487611485202170644041116607669505977578325703951108782308271064789390211156910392768384538633332156582965977310343603232254574363720412440640888267375843395367959312322134373209957498894699565647360072959998391288103197426312517971414320123112795518947781726914158911779919564812558001845506563295285985910009086218029775637892599916499464281930222935523466747593269516542140210913630181947227078901220872873617073486499981562554728113734798716569527489008144384053274837813782466917444229634914708157007352545707089772675469343822619546861533120953357923801460927351021011919021836067509730895752895774681422954339438549315533963038072916917584610146099505506480367930414723657203986007355076090231731250161320484358364817704848181099160244252327167219018933459637860878752870173935930301335901123710239171265904702634940283076687674363865132710628032317406931733448234356453185058135310854973335075996677871244905836367541328908624063245639535721252426117027802865604323494283730172557440583727826799603173936401328762770124367983114464369476705312724924104716700138247831286565064934341803900410178053395058772458665575522939158239708417729833728231152569260929959422400005606266786743579239724540848176519734362652689448885527202747787473359835367277614075917120513269344837529916499809360246178442675727767900191919070380522046123248239132610432719168451230602362789354543246176997575368904176365025478513824631465833638337602357789926729886321618583959036399818384582764491245980937043055559613797343261348304949496868108953569634828178128862536460842033946538194419457142666823718394918323709085748502665680398974406621053603064002608171126659954199368731609457228881092077882277203636684481532561728411769097926666552238468831137185299192163190520156863122282071559987646842355205928537175780765605036773130975191223973887224682580571597445740484298780735221598426676625780770620194304005425501583125030175340941171910192989038447250332988024501436796844169479595453045910313811621870456799786636617460595700034459701135251813460065655352034788811741499412748264152135567763940390710387088182338068033500380468001748082205910968442026446402187705340100318028816644153091393948156403192822785482414510503188825189970074862287942155895742820216657062188090578088050324676991297287210387073697406435667458920258656573978560859566534107035997832044633634648548949766388535104552729824229069984885369682804645974576265143435905093832124374333387051665714900590710567024887985804371815126100440381488040725244061642902247822715272411208506578883871249363510680636516674322232776775579739927037623191470473239551206070550399208844260370879084333426183841359707816482955371432196118950379771463000755597537957035522714493191321725564401283091805045008992187051211860693357315389593507903007367270233141653204234015537414426871540551164796114332302485440409406911456139873026039518281680344825254326738575900560432024537271929124864581333441698529939135747869895798643949802304711696715736228391201812731291658995275991922031837235682727938563733126547998591246327503006059256745497943508811929505685493259355318729141801136412187470752628106869830135760524719445593219553596104528303148839117693011965858343144248948985655842508341094295027719758335224429125736493807541711373924376014350682987849327129975122868819604983577515877178041069713196675347719479226365190163397712847390793361111914089983056033610609871717830554354035608952929081846414371392943781356048203894791257450770755751030024207266290018090422934249425906066614133228722698069014599451199547801639915141261252572828066433126165746938819510644216738718000110042184830258091654338374923641183888564685143150063731904295148146942431460895254707203740556691306922099080481945297511065046428105417755259095187131888359147659960413179602094153085855332387725380232727632977372143127968216716234421183201802881412747443168847218459392781435474099999072233203059262976611238327983316988253931262006503702884478286669404473079471047612558658375298623625099982323359715507233838332440815257781933642626304330265895817080045127887311593558774721725649470005163667257715392098409503274511215368730091219962952276591316370939686072713426926231547533043799331658110736964314217197943405639155121081081362626888569748068060116918941750272298741586991791453499462444194012197858601373660828690722365147713912687420966513787562059185432888834174292090156313328319357562208971376563097850156315498245644586542479293572282875060848145335135218172958793299117100324762220521946451053624505129884308713444395072442673514628617991832336459836963763272257569159723954383052086647474238151107927349483695239647926899369832491799950278950006045966131346336302494995148080532901790297518251587504900743518798351183603272277260171740453557165885557829729106195819351710554825793070910057635869901929721799516873117556314448564810022001425454055429273458837116020994794572082378043687189448056368918258024449963187834202749101533579107273362532890693347412380222201162627711930854485029541913200400999865566651775664095365619789781838045103035651013158945890287186108690589394713680148457001836649564720329433437429894642741255143590584348409195487015236140317391390361644019845505104912116979200120199960506994966403035086369290394100701945053201623487276323273244943963048089055425137972331475185207091025063685981679530481810073942453170023880475983432345041425843140636127210960228242337822809027976596077710849391517488731687771352239009117117350918600654620099024975852779254278165970383495058010626155333691093784659771052975022317307412177834418941184596586102980187787427445638669661277245038458605264151030408982577775447411533207640758816775149755380471162966777100587664615954967769270549623939857092550702740699781408431249653630718665337180605874224259816530705257383454157705429216299811491750861131176577317209561565647869547448927132060806354577946241453106698374211379816896382353330447788316933972872891810366408326985698825443851667586228993069643468489751484087903964760420361020602171739447026348763365439319522907738361673898117812424836557810503416945156362604300366574310847665487778012857792364541852244723617137422925584159313561286637167032807217155339264632573067306391085410886808574283858828060230334140855039097353872613451196292641599521278931135443146015273090255382710432596622674390374556361228613907831943357059003814870089866131539819585744233044197085669672229314273074138488278897558886079973870447020316683485694199096548029824931981765792682985562972301068277723516274078380743187782731821191969528005160879157212882633796823127256287000150018292975772999357909491964076344286157571354442789838304045470271019458004258202120234458063034503365814721854920367998997293535391968121331951653797453991114942444518303385884129040181781882137600665928494136775431745160540938711036871521164040582193447120448277596054169486453987832626954801391501903899593130670318661670663719640256928671388714663118919268568269199527645799771827875946096161721886810945465157886912241060981419726861925547878992631535947292282508054251690681401078179602188533076230556381631640192245450325765673925997651753080142716071430871886285983603746505713420467008343275423027704779331118366690323288530687387990713590074030490745988951364768760867844323824821893061757031956380323081971936356727419643872625870615433072963703812751517040600505759488272385634515639052657710426459476040556950959840888903762079956638801786185591594411172509231327977113803294376547509016516949650991607383393771583323024570194834740007043761867199848340163182600846261965628464911822568885752134637549025418083382138352224525872678937950537591560357945469850910225622545500301757104946983348354532383526078709221930458178230601237075328067836854130658463678886643348624936801019878279963067025954326513780600738639290856483087415761874189734584845014188976529341101372215864355991552711362332200352667785915989023144616332102651966590763206152438374761904953158296883626504209484010565458913062982771724980964195947234046511041982134768935401803825695495628603924426415986748598228006035386283916620125282660749330619658496519997941939322601723571073364253708303301143362498575363597042444647599899995085504135497755858593457659092653330725277541675843146693676780617035012003844874883823376034407751594778122188307090008738662736209166079905022698927032189976037950989059108591039296734561461070030458192127389259926961062116764364243835014102040863214991781529796815223798322427375365700855346997965541385905032683616022278847554706269843910885210302076860470680455684656049168649886061622295232390709809262930233795648217998163264582788887767452084637197106347892310667546935504761519778169902588184040792751090182448278705250597698375351430622445090220238243982312550584162320718831930069360646468209659500654929010971618652636721610741713618377667332797562685480124565768279031760394655539452314338756773034979157858859101166374845567584795271391860878254010423332985744274711896961048512640197504359909207662155899866073683762318835884508129295011466535482817144846405686524654090781547161962578446957526256945516560151916402921798854890937328031465192224759003096571549050536104377686877261915952844920464786897347370859841384513162119297201263424077369454598186502965923353451256845497454112981973587667072860161605620423063606613028149677344579773775055756466547525632264817711699785708712283154310456912326250349768115245217449739613674882204648051968875434196951193312045021605142938484475452382127014383095785581361967830231068508084587695205905329468338490471209916255636503400343967082893369836742300157511738515126912306617227641442160751291734187471431509324192491416096999867281582385925735982389484927491964615227227333874631213843626211637946706203263022505548958057308375046129923113629917306948940734258831948399927416395098443963405763528471756276219278652253960872013108048640653439616887545253426309896951761901977096319225870934216595597447175015753837674152228057065028068314335652491719973335840306415355075911597426436648284662813680217450590970589460274429263222221545945075804657120606863990430823693969320823749076756119017156130542481331171524256847846336377001520441791650116823257523616049574970639082244344451035121904881983027600176680985096524543900719909803499302686067552387968529219473239335237008665022140746455403722234348167574937314464092837900653919677401035586193618156683661686489239555496145282647289499416061580304586789146197172815545110005666054249969197410279874059327643495371452516769462069859788094695017473022841427571887194092120913799405943037050436483860043464522799330292390186592268987499211325656055784014233542605895105620369072028939315920440476835927636479960059640486076198915929819495087878602766345990540426377004590080327943472062982544525635647954299248819864613617131448577346995347557715549138423928940175403413997384616948129347924223460974301962752301382860722449638095383840152656781976450758854785515549234523478164603306293884200995080326014091830257438577067102522724366690598890854501557075423031666592472352892470258862479488754625276572728515111287827067345431024451523345654228431103967952829625019369893998347396176398809573541526014537296468147382184360052109947211941659149471670520379225520963364584846804144778030216472862399926404836350877374782450163820089524032253437992579012926564015553775409175170441962728503912669595666487724296766036730345366873404907914188694521471582790815723396912403998586939085517307980195554612851340891206108401221361707057043006056924685591646883477332085689141267942844804138468281325692914816010978627269686686737391711893146226913489458042778989960814470952476290501926031164920686774331866154696689660182266357878875060885624356267893279735463390418210877463803921624477202567269959639182468778845549717903851583920474831990312762243706623509251877543414010711233586590774812206376345901988422547272765529050439950252444039113658267081330058058820946031020826134136912757293699289302996173089284367031523858975398738893680744152637379424050644876417176861355234326986572897046306918017427797217388985944328485205725758833756382015054672065167425268189485167332804630764781329313260289322936604521021318981298766152624448748669389040617846991666541748508459797014617821584501491957210982508923451747451225432738681972586494458808377139868506598408545773165416917406705211194916628633773226375347566637002212032752438999773600607404270297220363477804829883485518952507947460551994034011077116972564426100509205984336253584706959718576261677663021174787834197564450183804102920324040882661734433909026352235050682858285443283961848092537613082011562686990799911708475558698215031007356324042198856958420068243992695378440320222237462814765923060554747693683057654967769047115962550247450780962483744990802561375091562235908101053449394177429427709144516666870041522854463807661535114155648785493601138747310382877331338839170964617482906315678806518276176579853502166599860746401267488412113009854993833710603196250670279752431011937733554853701169467485888836308033328773957165627534036727218070562256232637414883349928997025897729922403694175074342731419415743246679457858603989407509735636368881567215967635438066559393893438207598406121606431766442190267777379914557994503146870871626622652413359056992849400637274490882163524294802256633045855363633725176204907462406293896239062203042487268843237763173357420575399757437350840965779218088008942059066257278230769278865644556375801266728095252737982803007663697692816484465127747382239706173856750714669274822037488112256399407522762646499465846367401955997370283839311988482233553996497833316500846749125452295651240939096378409541690123467537528013908083086302265335238706927307198465464945497910113428715463669554343746215439188652608536697436653058856216441164806891283735779434153060947845727098703797692134620596953884382676082765918177362766991872780375421995417242833579106452061373688470854516582219315864537701831340181882725109992291761471186052917655142288112356621724169268062064884531761516427295358579837541237587610041547580559573012245927671189527733382335604337420132139280431705337946364642835199301457670649184770776895988542164797337176962594393864807489363320109889364352832449413256931743832350925828642127620947343287998438719829162503588636885744089609161976755302363614784018627182770889136039893307729306029671776025841803013347547440609321822266207705984247608263794138859860193520895982194188572382371427193034935451824011267104607309741268127907272643868568154472914482676138994509206409879264769257469881233464299526730823740572040614374870086704861259959017842497684584473682482794782475317633817481479957103120339634522674341512372232245462654632835356424662778646083987217912784308964163642223715282219986085060015824516947831892606016582749114277493350286550372769106810755782646334039921922260220859096784186001385965387726582624465759769406924054180444473847160790144974301805588933762376129691822923476845375955646842112269873163750624997118229148568960447252776009393434355833919516513298562364589314910186084968348033809093273626106205479597042129866988357356040434712839980124980220946685109349040787845010211768427634507913768760974690066575968304351926667656396092264884567021285074482118483610290768919649340230064175317348391475891667202306924534710762771979252499732857689038868014178031379948365108952722094659130450665665825853917469048687264990254676596659916454736513425975557739734850652843997738449051390582943013000836696145566974853779340788127721579148721071925886908927787873298298221457423327326598798275695089884530624022303648634772296705652412703588783028194007498057543901628578674553132719765260710764315311239152607721936214434609608975872693422367433161371857457760811775151806966210479558514013006970184500702629047949257083712017527937855495762739124558714833201017036184052163681801734142508980616063467633085050418458581662933409347919910368591305378948215865170118121011333000669577523278668551807825675283614949492074583733684581369140797759592526727396642347874661439981964808103670506600523826916505514463471111686742817731950256064295163795965947564498789146144692593662930936480481617405980821425434052521137133240811391357997162285810141910341046056929078249895621456004104569222141683089323666251761869627171945385499855148427517336924120268015992808320145830075448474233126438780847808505610430490999936434590519518749484369677275747335967088334960915744743575039860201639766611427653695267044115520019391484293460101512953117445887648307037167739615426559139908303757766302130990871271988706903293047012410586150639985299814175780430348080358820320201104760700475571016942341203410891564394782530316459373043755819468675253495323013027678235356011664131117799609979366204344956968354793075431132755864318973151517106443218924979327780126496476447546707816580740613125937527184740881611547981830781675104780929141395456463116058126905175395355691577558041067198123163840527755605227222376471188323322309958506897101871750478190653349485842325976225657584189852914471783351732260298578629294346505636693216262767381624595741793269889232722066663608199249098883146852994099138673444604967084244297824363023293891035596560173994220198869025724547140163300961214618720836510868818533406062201709951582707044233704218017669634913369599606432200532887349489313596603042438080456594474333567831672703729636367594216999379522" ;;

(** 
gelfond_string_5000
*)

let gelfond_string_5000 = "2.6651441426902251886502972498731398482742113137146594928359795933649204461787059548676091800051964169419893638542353875146742420314383674078186985054875748950831147839628583561836083461266431794091489100534014373950342870833119045271169737315956529056576328457297981774346372848330862819349528549927583773563188830693383234459611805080976879081261274910728976742978426637632502369601695624881711639702926903859903555628460115605232024465006631806391529947959280102745500352847408628685697748491775145744996588372975745725899906388280003508036903733879090467182805383659676795228294681896018049344615328808423789947168382540568693719973773623543726326713082085669350247813249584441266170431183380998258190363113378957685095232730797115780607677737672559957796299769439384975413846210683714037918940572046075515482487463115813270055277740580117488694405652197317909350581370671620544575999859693906949876978769247287723037903391158915566420267606097113568152490853124555456599355741761228151551680899339284142161770232062626842896876281108354897870567478353447994083334164280221005939665814268099506656731699682085700857612904437186645383675046896232582721370112050740502386252630389533268325697347198943234550477641417747497473252987559073026395876017811879634413615303763505385762659815196734847570797396637608468720047344119580770957940634323627053077957093296260478199325554149573588752687081621624236506589930746778556987975753446508559720699750219983091077608980268862489801452899911236684871179874279954411637105880602110171485781070632949664966383211861495485877240590608092504748657763832877253295432068289256776649101883658978959997849718819652644631951910159879232861820961763086731968735658298762079274371471703151308725777185995258140397579936758760782486324489438492126898947226536445638549209472367778232932556878676532449691522697937686003006888480147654028470526446832672538365906814675431912844507558089096325837811183599592847614815274128432280444427943751270444589333595911610552127662476071477299595447211237904851708529907135856652052658077904400169417757267325745050284384593187351214967282016534306508704875088107081592539661880707852874781445229042793329099932487862434841141693095024139215909544720530259364791305772975374977790283838955085048632930118615092826839074421811608520350623975621276467162153470182144447213151970925554350261550335142217480824613665054205790476346152009804980523167200749856409494208546902692760522090074313038876518895331713065829843511983275479349712534014612368778761270760150828718079077888254715109602198551001849799874736885974130620624100047994270009642059111865358968465531060956093913555830967730663641821106397818608555349238785486779463795927815679781156184274299331197685250482152397979683853051596539189960297767438889409001519659756765911863115134338564554120915446304049114843759846773520831255769011501990533694830124459998735633418796377029354553721221650639616544506440628174132297495776712710713610362169044765425272448854657623575370736924752907435657443587063087984761989234127453507924428993063494412301554395899669441869728157946968691817246510810696771807333613933264891346170526013472813503273366328879609717561657637405688542456639154295105132266785552618590634245572474531064437967248384243660973310261301962788323294282989182664488619519450530776279364469682941908827360480881184272802134776137170514963247418716365904414847204180039190260848301123987956915674533703410929292923296959428262159178683038454865630355345786363169524774334433606482530780095967369814891480177515866411234910408535707894307661247276902693120710031117467049254516506800548375606922526164002221942509553588080136910653118343200681022889082234971443641487035465867971183400897971358143929231075257316980157528878072217704263635749564644315115082418914869620496595666455164093238948823038599910828888968392091320798005880057333505563848541973539461096297153965771335238612194253316074540424835725692746268811593522664830701810715871156222545397078809433092388373361631631947417287158757831873154423653491587287679950765804891579407267908959203382402953879938081679613436432201248883477683205430935333973437480303880474427697686181765360931319448200906711959248944900900156291864764444187769646415278045358372295080641509699847571851203848757578673880988589434869685462126136483033908625301470195114012536932401735841595030990648547425165004324308906692342234975975443728636952656907797587595036153134074249054489849565977284536013288737186663517815490718973243066514751234951338731099725280097917867046098567843106664180306035845326482152856549981658084639005601689297832158367641139465635200146384384539511916003380305168378213774078863950504135417869767213046753863299412226258621951881447607838934242607215995313654155013517732491356310694124831707916560534259827153275313005698765557273885052084980783063824366850135239824390322195509306541048455546492623948807574615110025536001664029555940134820981685685132569492679638686137761829615271130" ;;

(** 
gompertz_string_1024
*)

let gompertz_string_1024 = "0.5963473623231940743410784993692793760741778601525487815734849104823272191148744174704304970936127603442370347484286236898120782995290571966173692226658940243185135143682937632962547711879740252432302052117885737856177283652365137855948674253562181300812083378423844859598066698359321782648968604723109996451085558141538352061625750083188741870175815185793100506116043552945671034015036663635029755807141964659205370602563858754392239763839327096186355595420814111724593386546524955277108782999095803509299179162163896356913550697312554899795693719307178438701469672807751781700499106605448472254946244137072561379284901975499830037495298303842654768245311138966510460616056987063506834716189312449123052641499181843438277456488042819462656914382080186774444601748313698959152675647833695487186740099259602213107786153781858902163226295664207851298732516334848758834025684438975074794386153147929939328077843998817695892198263577406237721682280571699160696330066837801738278339632544426209799414229337385628490796642900584404" ;;

(** 
e_string_1000
*)

let e_string_1000 = "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161403970198376793206832823764648042953118023287825098194558153017567173613320698112509961818815930416903515988885193458072738667385894228792284998920868058257492796104841984443634632449684875602336248270419786232090021609902353043699418491463140934317381436405462531520961836908887070167683964243781405927145635490613031072085103837505101157477041718986106873969655212671546889570350354" ;;

(** 
exp_gamma_string_50000
*)

let exp_gamma_string_50000 = "1.7810724179901979852365041031071795491696452143034302053576658765128410768135882937075742164884182803348222452251457420010557945742481965008815685751264500115845957267403582819679429095069157844524441049506247494646739544224939206129736671899296118178171652864420491963881484122168597921107933464249196247355882269791909670291501543354860869336933705469455901623274352953259837257660570361859915224391778002468660663586117287927837192311367757393941040997516402036473484352386382021226506642476962500214726344491448434885642417897496467227286134738816299081339986376016509512259304703457447559506188914485699239660739751621563426286549551373909258141962310785511202080191889749032762449465399591732002370234697259586826750486402405173081733368740500949810597645868702938963670652487156977099065474242118012041450610665188158903605823941798519634236370134771763646188686856689181798821908601430001906672557460571272216991141893364846172248598880697552631656064648854028227864001707148295241436770695174657522359871667462739793605425506519243889283227491500350801831900327651318757803069558009536174449567011815778572529582511634151134304257216429406936876918890286922611128033971469700961924815444227806703473677898067997705695077664904554018882708737909528921470852564851683119463337125595229976321326385162799697547790895200821585172608443823637406316922647089761403515886246272490905691774787452295997995781965125597130801424126103422322700768581088320093616137695266915505006907691597400999828937619988995109085354392295673818076960649215465007080289456180338685650114747329679820931915044558548771103996419728178478592954942077712260594051247424356659086194504776468219369536726009105711522003747903896324595841443365967039071410791536411512219665727842136497451847887502697163453029916659802097444152438138976880871185041325416342165330468767958798651835222858876207410397177171007821636065723017245662878815165945797539484900185139557387339980465839852133119631749523936411682545914891790675595848622917224100328054908577696956740637759229374369531095119510848400573474144858514967817593610804844827047460429113758570539095427348315119018607427972882293860866733201982986863733481919230377754217649877354255902397904426050081825603823414400137231725284217545529513938196412612293494992552230167225608076391183784452869180576407005494079015529563592390212427691923744510810714431249092989144140980736963813255830240992476028781973599760481695950656035080184236541687609752771589184641549187401069323624467176006895860593414342046170089244099070776559402109102185563805258598379640596533463130607680361768029342320500353757434963046461465419696938639477823848031958705049409684350308995986787531570461413423248743465261157810784269174134867139700345586048303900802840784165428620794813381980623873855526396819592635738281403485207172263810381197893790246083335416860107049980937618447151306043333448849010051775661691141042673212655310550030057723164568219798995764530169685664861467075971104149479105861567586605115668473331003058962986109831365880239183377830229977567072220183753244865745477648659216236365417403273090729419532401422757407757370196110632489855842765640335393096121215739740537560484323137406929422213781075692498462810508942307346175366117270032703077476082009322919619018024833866147668985277308763965605610967233656978950239836537168488911493146318095173433275888854617209250964152085933738487410236053989398039997226437382402567090009538297286541197950906602163279902635336869151799693432465489629840319533474665379700741067322322750819260551267753908230894221408553014065776522733452321874965542786833739012726340265624218087656510282798698012701128200205893002806856651051051960540988950648557223157350030383136538045289532209410853860540155491360711354603343146296770930233289374891653206553475504655587247951469093457424266992418993951151356039455636907170228976938866081974310573074732531425269661495178010761997338539950385872257104531063170932661571733275905431067315723851092039416073900795884817791441858197547408653874217234072325764095028575568139272906861944786129739907140727938847161630220572002728323451865815892439627794753425088730937229035954472813843739647193593378567254556278644841043060218614476514265181821024514950901300813458796461545698528272856532358838875791566254913930455788668647493037943512857370922026465137165348367764850425030427685686897796371681970061602205127174955699177947721684325417225541778805153313059998868292101047035679799341180002430195734592482795870111994155798873437788748742849758113696715509292873219979672317085833821692165438101216484002731156298288330065714034267233873789165551031843390164461999191378186621747571520652728355854137823356783089885469154135210814552251634177332441496195949179168435217149138399692689067056435898626642806487295573421618490276138440174426791745144313397119307090077557445270732143143497618003917326410212385093413977503797709037219669665383412425073556328170226755867752299283034787073798214358774198529363866515138556831866029466818937882134963606667098318662376771744404397757204577355269254410059122625645939031331234467531870799647032149927257513097917271817878672721821353148736279197190213032830609733416073124157865260460858613887387185809905603075847303448121643387491692334334810974624657220266026596278827577887441970265469987691083644813098948360991662840787174020698687790815160966569308773486244123953354787901891801613073691987943573986032060346460175130684097314568698550703995592672406381487262839990259575172250146732684603966225609137987864407610427862859908637768505641214235409148278289703499107210553694990165815705613259737501846230688772238930553874714482391257055448032869033300282283906549904908627985835766684008739130268430296952362154327460193925725362281618041151257609231907711513103737560383469417163301755102295436381096583269372900933146414972292770752759082327173323294056425207425747060662047962808341452812600903552683207084322135053168760072261765400981101795278474030685371980574798439413231644034078532443411331466324965543140819359599363247756973185632057569466711551766785229689998307905438660453263189605570713189962711599718781996180539163857893627409274151620937111991727583085817180385416191291290847189728212422270763689316435098178777396530272288895981274929704275035475597817496871990893343408697266799944193299139015088250516408582499587166637815808021343898880843642877725917425389374305491645364293774194959853936145662974797824211788373080812354256496208845228350890282282801492501161561269628442612032284379893877630301849759692081569638781139282745309193455907781684743385813952522285909526148237028844780492063779757595248236175999426331797781813943515683952147391537730699522821974690768428911968666477014953903875722074553774757714263431045400618007311163556759312997601491841245062590515286500713592172881935886582573300725106321203256581217759433445601710392512074546320016810299694880884522073115423462217243280550570544856699155269872204029473528404857626817944620549702339884845985766961649288031263035480121802791441781699672043327863451597463634432436823235162614536487240444703028387461315090451269347903216416130349237352399422962613526719948262253785921456445630770489920551214435299579384212947986192408962883763977507761877183974783209346048713017381312386483858355954186303384685423392644839847525790108457402957925964204776763097516025055568194254145960835474273434021344577645402257373114964043610776708094304334624765999202594238350549906160368676347388199392922814846588150772924730266336419167232743274177458169439741250457357677215840458643630834418481863974635192124910309377935875183980070547833889403212996606745706344169602027779862952553609593453792289981610115165570690585896260398777727382390644623818059134738766475262330613652378335143887571694828014896878344209961626921586024351163552184012312736740988250067824771248631214124519050765642776169134595780145999887187099442119843624921062354192151022242941662685349072301625832708591683767592223533074086882605720240282133351129550764739450816893556933746489320007187447327429297582763465123018939987634678411260820079552472037179839591736012646928084355045660835506898585179624785155766565036286049584245622471281803171289872936029377217380927249123862359635748919966831286166372805423665733485298704160614894808948408950946375218317381213615649587646308434691074101347594082846173366871619540502364581222427732588332689649674078503101835666372744000407861450375277272252282306963454752544637259167370444297617994497634098763152743675046128530591429175836906674472894942758914390131004190374466963251070591509424930516268134564021672478754626998413897677611332451068253100478778603868243717262330916343380180524081823794911546308173823433037288654430817013389484694170393634280560209991982691908604465119938883708014285050097801541115968088638160773279378932663935869016965666276520830899779624841965763273540692688690500618148693655331532053937250345382245703605529023769520729050347600195581840190776821577164110883117719952467364974077466405472057736753767164538403481977676419862640745929533657473737661999863523957029100214633093167713370306558326301315401020190832010735168110005550441332107234734100009316921703267484768998223816751698944061385789548987895686352665304535405062936066793758499928934161916016891704840725791249354809748095434466666337816800610048121423553386745710960137662964918770907675778433146397663068893891824581479347904186285332068469096498556986638773001188111806110651264594519697132400174847580010784194703839111135313780032201019335834473707266501458256703745612135200298564259022380950336376421849849600854487082167960555408544614272161558571788330657194691443837167486296525077452489081812578347608518116388067759438246366071346246843532072267877906459927623668287937039169856275063120706620554664256544322267145714280759453063318388968420542134657218317379922102396218320533045437413829421178474064537415703617907106673297847506135627531669061606201511812496469607116084409006792613912270873684388706307840857127282870158761039768409407961088719594056969355314074939584932337681273721577228951874940308215782689456631806066530745787198008431461645169298494527459975086233657166846739484403336577067185104890033389729236550951262275865614041454828892184548250420257694536720371894612360211958923993417969188803952170038866196355671160832487386516356400525160523770847993330443387150086370596610114019702199623760195008739860469721977056089749578086934489057431770607645415623831904798894074808894860015348873526444768960583277864274003081009921596479810335790060136748266465222551230423375143543147430275694456009171200105999312452204634444604381613777270332036229124969611886446134278679894540812449535952402107491807134783479382884362386088419150270311196913673333505281946147118304570712683443828876306116278998578994959197145139681966589407699911116893640471240912455193994030345604294311477539517662207775468582660007667890359886405280975046839472664646593731454570348844550050004397079275124641214362497840722167549982026156518611316012330790317077671664590099348897610303506164660323805644061911072944982039841896964294522512899532460229073373517000698302617870467855956876832967684133516222815228206645739393950996567655281153166079311962287499337646131643282459836135492878812569932853688552264281175203240654011879590710657075201878887027693273580443207844108532194135043168210051686922869711756617643253465330609487204060129799770825743585125114640245892057078131650498847153695228235909678851632128208989367248327443304228191899938769989633008190694321925177876647982474982852315372743090133765837472646714789647657456704006140846081846974098755582533964058511664771802660200412134727023512322845984777164138518416284160793873528467548935569109794671000473742503856883029696725191731203261336898772671471902917110586510803127309587779921523364904212638333212303476604243449200143374839034710734050213569637761150336179134565861706284735721495480379569269146696932959260357714195218948902319909062083583661848773863035067782104185888619930508759830600944190483230115318980534079003593554677151137786802282135530190204541005199236876208256499197887785922442771679848661893507720456797791755335186563334377810322903148382943262315384756930723295950809434479343713263577246229975563074421392101041254995228116708732947746409338192476844601474604095714336176971857300242366450731739311802080302607429547926265363021694034276810415851646624233103625069801318782564371315268201029139623284595013335127561715333800670174071758714016054738084465171405379992830492407235074835118357874675680439138097314593230622897699489628886846173393149929686639992971762393443522264500799030407830681375655400751610012361565226781781128333829732467228248022923074768880221023791611404630235826846056255568464912844960449990598163582849963782786759666617204561578174820499150438989387935201070189235784299915354272705515894046168341149685242875908973237448302501160281663781373652707754595370395045336540742936825318168579327847337125506354711669350291951041588937658908312745268573836031641478950944285661436190004469093174915479195464716020647212855941242470504894514190391507321277813229256783056382492185675171934513621974648927707048677807426082588554702125057156396041329481157438358627187216268892255068866795781865409874442207889768257768265156226312375487578678528327795069173573472873304505204606039334064116774216042603019784458854795006824668463281737956441956971222139018768337867251699188272478057096524136349632602172664377689512433534674304384286129118975548759151113645866170515791775326804911006255353620711637106615201026705552845278755638738996241443246610787811807517417568073254206393095562127505051760780043515851226223698147201428806085813137335925252142010643391462125280404534314592506247175832543905684469366294616411174749709571472840939863556520501839521702331988591878319243716598956013492742920315389982896848952054790015260032031631857644893443762891696461052456200364617453917666310044186645385723845291403952302922717020183383272657296435563485120847157342323150627550463906091242789626358680404094393027210537777968601658445095361513961357644729631428794055378948439603293649393745770671042958166728854342142383265957477852521612749958976717121263170018721983217319262227385791080207173024971376696396124351832046978535992243452097548504090370114395152444789587419502640931827146180491452506836549045427052519929912549210880370294221787244767334698831331560564168974336097873102392100272119135554618472851811046040039412368792389169109208331183785932816978044198380075746297746291668805177030669337457881317780266588297000927345828715257332483069732321468127589276266564706096199994357768360033449055640940873910285257571470299317169475323869955955020464038133771631183666744833833874777585722480914088577255655265431671901229887898262193460957757542958044215744578910194672794557243700303203485185140783475520342718583464522324544318021590186409719020865137164627711076012403523016805074946003595648693252161359874189762321117353663076889426917420305086735067312778110005063284161688472929107286026408112482690656758570022794921220918695409289606217473472073512681099842086142401126448104726036055428754405012833824907106125918217169098577986399028981135710363952510487305911112743272153214887494735559980514543796484855519287216536002951606477736244508029916451647022590863365081130081997483669893146858804011860808454116003960603335905469313421804800694550533857819233492654788856252778266680700883626615512841559149956049833121803647727879814789540840218202258858407576016043188459433658006621516552428524735889314790669095633454154669579872485707188442253327388180528300453363541780460434162403966512826165941742093320750695813649638555168955024842755785715467056718397323811848657776323162831565591443726553291789561790286665320995154724388989594272966169385725591519936787721832516305730399197663089667131607662443458998627258706298980561426110065407528888388595804887029720686852156246671629855177822993717610966306555327905443263840126740603857812374718531478757553836437399570639611733829272088547114122085661482237531567778635505893288202687189024919845865248524039336678562953057792685507103274239410152759688963098294246519072712085317078697492189222584973034195946617912588576836684356923380966042061761252057553194076812584845014497795052292937484302942800260849526404990326096242447169599222987398060920061494336807205773261952969971891963409438099782739716482096262426592283324171656636205293866975425575469865134498721085152017364536151103846233959746628422730941150877281403136707903942202587545564770019356488517604611755944482223285643888342132003806717865560285349928056341426883765703369323834717934835228358453503077693677981844989908274872608544376749428075275719291234699064228669967029160800337813690628138299115950511910254033822551887279029356842053237478946504534942653438573978125141067222272473226330124864711728139254012512327348701547597567462865641105221392309175996555356643949899818597500152861866789922470440609003205115703556202203747039226836606514204451481968101864239764750386946062536764884753524289960286054080410560666307773435041220033188793362485489664317623937862206324031931300341071822589545442526117469613349145304831053137025072470310000609396822403532692550620897983997942091291663275153879494650098007361437492378856880107581201290694566243464701220161768465279665442613242161100175907606474759543190001325388815207264468049906610688446040409380328711497950002689752693561804383198408766785709091778314847620761798959747469226994614291855976807644415647837438226668744859167335656538019408831842151516744300424599288391623914411818126370810041790135645227683318722629879828491938503977178098354809226482566952356585223481897789896529949944377254680033598999419888566078005426344169676012833245982774912485562539775882601687592155529021540098404576162708024524524205406244085482458450066993996288064323151348294972138721308437802856675947060103437299457955796354746548456232720894511172191144033428651010976514831553409310145640588464177928384034961803264254845889283622196039970837340562156530580366292754762492252771365345660132431427583699372999732427801137686856896094018735070546149993906193229114362128205830367733747852795501855966917087135162222949193381557839985830106650884142689165167654328072979201766145423707276622235884833657105542266632944035658868355079922594914793183465877781461573593026401574787964811224798282126409239649666240952326396284364626522833728950931874716874603561213288600767333207945277055506618806657382749319208756916637514856661168892794827695758503346696058059090484192090715504688848515138845337337264718016312619195431526010719234278194415051315042183167908015250466220045597528619462476329896573467586723876406537620899370690985153293883796133384562885645743970103977908598515197741667433719266641304339812733409851240855168897087327846225518263893037428118112308483401809347405905818437616539450552692022717568040614944966455096704380772210762261236719159491796161989493388744226948350884646930954715117687599262829222384968550906873495393290621691371886068764885271818362185245246445241667423274266437772513481688470569556395249367503348563500106695702788606105525587539488037695663131130160030106808895473444707605841943620975259563713850571211558362977593374955368936167472044092259185095599025887555540514367200729756791716810291634466086248832365256548859631713891062532324645958246572577441507800861418224862793796539123056618726148508547465382951945991382684916400227549696952932674051365948823706780998956119730407012901158647461972793543112269269435014557920956867677891456042448970216988817932653713209690009527875093835483148215402377857156135598894477567412820572503106330996795855219522366740873920035154889440072616457336378783954882741882992329621173937110841777588691216267114827222842860043873443733587587818087232364558033159642527098928467149987800841822663851944035140377539314455393030601079655290196954314792318311027193263447106364827467102015441873589427789771994452404527712115646728112762582610098791495467657354449487811997852222530545135867388908464661333344018524312460750947938496570078151779110380499504112918905452626548313081939423379082503611974719725319111069960728364554478754021559234106727117771438079613494831913532698617988135071393011288751063314239183562295299581864710593207171428430948252613703522669980491776308453065343603395584122322612655419212242089596588273768070691176212500539991547017579847699803442419992821974401503852071923219041826234206493644625945456856035109223330136992732472426860540367225476608807482144369998695290832792287074420215647763886554651140920637601319731509992654566644291143659698262630327262831550885178508207908715493636707437165637462543415666394453179441824559372834977078085203748716734636478204032953120023711913436228354439748665561363316518332393468202738269914427135228496922153395070999727887686831817133807291749371597189127255921979116674541054966419865713375355592051230831950281251144661244502045594272920895343275941368897278120496443268118197697730168132808982537314014759515787426576887982517882018290918929441949488658033940859174289035863292039466246768433344252417991578521203375851245610170792861208822125095397852736837317105467441623308135779271995622633853324708736486471854043527224856692244866099813679836225388276320023512037298182679499674934586225029479351153688045425735725434576729798159232685320984208798684292024102019770569961637490602728675674935899763878475101025588408987942573909729418591314868670559407416771531714668504423857043019214885367969255316830551807331153654788991841483224120085391305367979418322851476259861791776539209271888356310772827195539585305492925489846545987794586948127583732522575424843248237341229392840330390530800773928298612236315698622267555325074952193565275261957110295353232452786409263082433672162390161918087842442564841275240588957935909676255275545109210085866714285639910897537778400532670140282826091046936008039903030166677151388491671901529977448370014659191035367673297308792708733854198373152423625012199012762911559473914479866507332017111337078984699138798885726546706426856630842097143743590797266908310290263472997914584882092867588130554911172288907810735507189280918285492549365452669661682552532959349824535188519372202096523473287186900979628289258326842202213070860997416220843884199863553135004348858526107134345331465440754873786635147104591525095419478790536165617282820215721509973863007843642318504232663724348384586742292696953598453428106150384507684641646563781025130596911379241487539428951494054194406480273959872372628985963186564075039808825789774506262188408411513607426457803443535478485490788789501529454304441483268309819921751412078462043782286295823026926305196266719851632301304291151269787588764398033549127668141785368697676205810561473454481585636451183279617884743402313065685412264868807810353187315881388115575994163867867703747751954931479630980607960771010258527872438552382256070629022112574790553000359001227448621547893204102112582385777600539162570721333014156572127311167343441988497060021526812070314013770574374374203114281424530347304842138596317466791627138820989633688761391793666174852989765100433901147114734988941782827139203510488863830568744883630426076728223105860902757686007341453903217947450340316090762049334134411042587156782647560321272398346451716962635949239085540970427730318875740923688102091263055074231477607668307924737666276801050822441705897772735497610607618332336227027852299326938416463554442137080028436166853002403778499164929688292079403896584953623366592449303610806851090494544066953393929285132802937848107267747774779970730251727266589378809425889275682757999223935021430686737101454475523612119028854864893010186729131124605125049624688213311778221786105979207392981251214825982000773454880221897986974508685639537988694980776939936720141154785473365263080591143086246180371831230004612198917810270714645710484064193837001816835034379264301278616993142962660895905101559372802136299518666208913513853982191433178851435834906330980966080990382267321495847848773849350951594488226943230028453966942372152376648536298302933349650811785116499469333724981182412540871136511766961462169461127655337294796902079062819050262524261649607432590421846336014228527817752582396468304547875574073523666921319092692385904038652764063864664146751076706310848962421696261323505727540222137779827738712970074403636366132242502238184414958629488514922424269311922406241054184798055603666027915124033094237565034770231196405347115279781922358898123734574158370865640649640086397319473649756349476230669963042763560284627581606745249797736726176123749886071374042089921839734890661874391439657094145290626509372708203072536166566636298964777010717944203073535981419261458245566172082182031316549620733171249840430663036084456093348083178476907320828222724157878547661644487276524076222752589958721371065490076680192602603858650807518295940297180605701781304039468682508877711745232073251302954136278020737702798544963300231646031039511514166930253098671451982602818110416760129823250604263100462635762735379449972990355441892784409564629176705963250002027217392317304954004372386143423085927676459387618757174988052435866505636101507545111521912574221031960545588108526041404034194148643042733891504333931147844920025953400374102432972540191720647468221851299132475825653341936810795013983861203889029276238318246382606479314898121442702742375434413390576803545718681931341704267188814373175909376238107315993609235483776957620995667597821527577129049537919664152006288271016026155134913929276157691329069313489306916795674730277971505335931026958419109548674101601116401629398633706708792921106313303680652160612097356748478894697403595759675146027337810925450567976541618065775320901230931786169399577423734152617909709869289830633815002748901185684630481878058561309564184120393024701578075555164483943028409540657774927734905299200594126610228133754211233746300709039693212052809744298692885736483395407583731055169901769510534913422674400344314006043463724005310108465765853634391095874406704188515496073016261194852257937193893639614602437500782860338340221113844955415671047914556255154174311830016876854327783830639037122480610375319201299681464207249452953493790203568034290789502697370144920290646485905388588467238959885108920040150092227126831518643171919344164810250493702565814415689926975761627913955789876061638046986223178161941728358046086409452274505942378134739745185987269003994452053727171772631054090466076759616582700324527624232839541821923652889233330376888559478089636206281650216543319314745405044222947422590745165685319287166274849385685933104030898072195797697903553389420804545300655672848782074850691396648065271867864390526531502973974346703775889733108889354974952203618273069059556830239680759853058736839019068163139939988962651781143252253833677123794024734736488695379507585363587838655277099077033303754938134766948071378674916272041643613940529090736919549275583279735386336126921138742828597147993581841243752156122069911919224713673979075091269046403005605751765402570829441043705779130743765673054390761502976943328331777492225213593617559329684883662633031521860812384192078291227944590151278771596704403341698308195499173391596697220279393304539412789622331071213934382112270452583883620642229946154201682260141791045049825385971819717156646454295066491016277492249668363542698060668323188591721421358939863353953677853256964424787890674593278850182723024294891195654169350157240697251535730460437862218254309975986505134039641610218443035527224056016238339150970335722533320105546964107715765658675754948904531548623485598141201103510085000870909677213773494358269281389852035588413641567368110200471308560037683334512299583028884288568642569025424198388392988111851567970288588212223722400906905102728419016581359842941084063300555836695523411738741706731470385937891705502657055775703023996019068531236328700118285525815116222061903518809202864680842207333965016300905749205270200963104150080777195386367305081064244275487963724053962929315923112661608591012803814582298110639190865838628671804543225238263403027021888671987912271777313212308275989230943878066912435070722659294559979281669702526404871928366634057042459021622981759421723698393484763151275624387013174655544908632488427295105182715233048954720346087234833032452699869747328481229674083676472971583907472472773218494448223420654866660379794941696573501931899659716192336020310647561503084366703859461691356421097795201507188764262555142940633305326079741653038951692980913053402555919262538829700634692015955620836423731261504532063240367188923190271846560721963441707660377535862816581696302042975615605330980877902213419692700772576001428090876681763393821699385864779013977194464938898136019293323610028384536660036482967145159028129250302720671710662941130326208603069616413919422387274430320874459583345857388799340387500526129974081558272900248024794796778686063029602494311752368847624355035149378935492940062042523233810721863880132148417504467985432800736583780991315866861472763536561388322188926983392641637116780864453390660332244651585925756609282629403800457144386263979617130085063894892968379401858317889089919368372233068407147823655032277747612582587468841679710743872021007210453300689788920147919493564981223761784676259403619177730880327293972013229780083162283875310472706129156564591529721193796196537579757284687771006617162422766088700605170289300067870525609723280430188412808549828197085793526949128353417539028353006066969719807629166674405862467899665578830873381718464016630234383622007277493575063124415424550699845922110957987078089779803129556255225176496217679212840490496412000549384895795841525906575429138995325421988947241730233235317457589090271055947340553455421876061130783610117717063838853579232531761133289680130046807081728988447925834608001165913736192031900368516236042180856959568899766033659628131151726126266499793725235998371097954394590648204492835609558027828397906201893047978000497879083820098139654179420365567302590068887413932671007147681153350103721214935093254568408178519127749466644361281261682200092788692743365865822679146474367205129247875286558073243781187330950104554633037885327465043974892980468807666363663496302897536377366316516787934185866585613352505901562889821939465648598828487751663241904524103958620292557348094040700020469406609282637227616745893120885052136681457323982272639293724949806301593796163818075079370125014307817965484244648114914478391766795757764618624407775189880951477815507622066314406228565651501131677127058880854216642288364467945012726968398826508209486136599941937714592442147640885506742151932452624133290273018841812157871175391051074375182415487832782600721818496514850648122059537056431744507518169410411301803158103948536380263387399309778779210212143804803296496033324444424565417340468199789941899076560547476728547913215999423322166325289884601880330866201075262419824844438586512494349222997571163383989868288359860792035672350950114465697050638834000140440072836525357836696790021843937766388943244505499315440564117165250216685558417205473280490828418304658368131369589689553255112208780534918985228560966186763602809414539774723032004072552619380448396961797957887364622019355696983970638254456768023201044817510100605083065818166368043592297792136085399670850288160325765417955394536136527163938755522326966917737953378144619756329724371869643348630417102641856754990663233982882111371408953089385134523454744427513929982280875769332946182980116233374196146091855303893274689741828220621396076273115114850650818828236670128658676367770066120534706993637098888652471891702669101330346179762376769570079276183592253192789593959291966023068624937636220044254044692850807948221961637730681939932862937403318111482218847779044141345821182553473922245382938880872477711555451287782160114084710728924388391723193252145033019625429729047473024697486097693250020714701929733352901574069568333680121743333206034998009513053571810153692759107913626500660250520960342413371318203456096221583909133405933800958249801615523199319848126122805269403843469572619353621999768642217604793844663811655673987508067936092256604038635239683487642922738809268443629498338278632588662783473329992988987753509505825793876247478104938452560861107580134125654599238556073978253081440777419688639719258723468868044599692633051732676995226202497266070024765098909936432830969738965812342578666902903920372907010946223379063358819942745509042734830385391053747974287216452091515024726379142900848799430007631672707721678232263319920194109736156572184740259360971108855760262018726318234811538809921746185245683592913726393139426056929626188448094119480088457778565416399359753243942574774183474480070506261206719281160823005599389202728515990509246443704369025166322333388399911341665710768475593151981049067595384823222383998023540719038721714576377670548053911808573295120967930015717124772326261417755181104012257091079504988675296478348814440594786712323469637844038140775010397763889322929773564669571053069385149994284161857611108965110397764449512729528396648556111650656571857737383810494988808935664830831209669933785661323479654754148064176279927799888719174901720219444587315493062417009958590158114295788654339099267079724482732556618977376099842837042143707065736846490859164284485101787810910654172878653922649279568949104539442354233077337948159690533471076927754666764466486960037376180794827541038379737059394374312156079334091168462648610587848395680511883104725132407492388094212702031429409594778371606491805391186428671665284423709767276136459192777743628188142025406634854666912751420157974446438349788833070467545251332603155943620189559253490183417305353954530931335028274427904488830022453521951734907957982659343548041059660810640991174648130904989036693933407168296870627583592226673685112609747990650948019151675751463048206866801635267269226287267659182071851282170639510722753693131375658343601240888961238401191027013931839839550537779439672127296279628997021142425090477111255648929471226607944378277395628277091448389122805992376019967634441800092773360216443350910123314451011420309280717624241025889265583033216361043952177783375842579441328860761007107634957288891635280230212862722900933417718310313844265185039007403552337300449276166888659212630607533163868546986720608514380142043500968104661224538573219192148802275116123063238043552376600328032162360543170278007075321476256094305676861275698253528792481473317934219578830015478866985046125592450731568255484422716339946842776988544768416860026092443711090009401454032657280931456016572853780489778076877890110845640909740045095630590772569964679306004859093147883138292847284256642145961038862360931111933423078515383385888549102577223183005571915424830717791319911351934220869887984569483911507327620820767619713130326845276462117394532247871655031479844379859973706218900572512652465868795937198085367236654578975446980459754194987099716670788545759517008786956184985486814167924174364351287665862925213337355691376068506116455790110818199883301586302182702959982149750838640125820583392767410815186851461243712155618379140201938613237968799779992454362133895117729906340694171447439285570570793760509215596662636307189642273238360117693029985095192260989973066789878708707855988191385686228246955977245691680000032337591432530433896375520585299814574755937363633305082351258584359142000465925279016018928173150275925714338265170021730739497164646633818576987159643640847661882525866215980680695331510831870332750902144927530716504074958492236625889870456628664297166655029136266002589041299994722103417626404518751461185062056847508357097270272639930031791124071639485112929370410972912535356193145647366860323084600534031429779334505401545581423133037161998347440284775589330037078854994967587674086780195475034452400035166945650529515407496003392674086815545593875069000715997331888232170702591465134618840788415903668456120871678987679446284407023779204793927661835979456794455393058193119093698437766037711829071586204806229797640709992023548178155608462406405590568808057096305364430046481415367384078024402120689957220170390176959553160727695343977260453105896777601857403243543825763092076827475116781791029165265664433395105204742832947755771111959137437184254737194403046368689255673242409827148538534161709443495851560627091871900574491689741637033082712943418801591602568296185558439731196533887268471868579344810614442489499385729312400748936847315027232226115051991859898346274750821859202490588031673981408235182724750280279915885362511811051551026986128992640464620995891444487118566453462418904824602897499903057726115963089763252381336983193954225637090052016159408852363487491866238124777085283496328077616302747456828524541521338381898594937204387620683177284314576669076937378647711534201015993255856167161970483916962452904490701966286413004362848850303637918552110964529347281932427099774141979350874002696606847315281290204533820168662534364184881982010832620463845198662740557400018403143252710532784504794811826184565729110136298400798753639748757585578367923740702825794120832422841866080888999939262353588282872035648208605252793665880335051583799431173847233972346594530549076696540385713093557228545378471138896658118694819023736142769666509392146009879900894887945063666203428267069916692200461054628286986881669238301083607747133785072356835263543758550575382563956525660843920757202408530828192818110726768574073976224568482900654932602308024071038534588624418995836316628564400808354023955948979353223316871815692095318151223941730575011925842377275665278617110935005542116011687346666175328859973994738888226984728709723831313889440137815317043506088536483801620797055437105476616913901622359627428864112139879738075389720609953219936929425665653269359633583715824916017339093495044862752739415449575003027610360418009111275166781435417166488474653541960010648754736912332932068919261618615873654463186285809025707848159008760944369444633615115606545500944428328557772946530039337813423461527246529516932593500990352179419998139881811680237341704790196425834596128442803034419527080178163636748541395882949599467077769250944827605523346620394826757167440134748607085949877305632159389418005901384212138708387782666395705193332890206840716589569302556233937572506696953668010526200028073068432206089022541591575352954594433327708015951355755244077754591296983827984745297940626228150859299721306346685643476227706180650573653269789454352002198360477466473784389833897103104440318948998767933011675105466766985690927649699697467481927594924487543837244252593787256241862828561711142346900876790484463476819636224672324192726530591203299503732784889368782916818998509888220603915482619419983956990963466586173015224140879844566347045161029070375857508474974596019458762856990795117092955013410812020916452379779415960922302154850519546466876369744570659674837449676150621106417357393331866992243735589286157558786308235607632390450544399287455510541533911528769901861888503826801129497072262686529385054577149643547995597448213576702213812956599298509617858592706104397817465391328184073234611311535029389176392038378691810391813709537316807704255908714408673505314039078891888278298433314953973354453216228671637782624912192676278378060154261704355868796727621170920193266737274140683031636348884686332453029965496408359525863021440817323108721956620166352639336981076181758751262503542491855292131217403141440120558105842507729628119815738039735003709653363701604454618446021905834864750137278325022266478744370917053816681106822703852503147538107656044486931719394164774375549811604540175730063792723519628124411412536000087277624686337736631495750666481016052178761482719662953729635757183674675664699711709038403801964485978590567649486367261401826168890469246883838013770258610778234454734334426485448367401738360348930363848608035182821054503591653854679524707650540170880623542250261557395961592842305207681689272017356008425760137941096152077200485808092740566570612940348710304761942713754747608573103963026542617519677711266928213105955759572019749288921818867325873764569783944175465725326823621993862489127628744025793746936077879627477792602469238832934443630898073516755954768176799539011991659328105427752536264946442993968348053168412044719481104296574140039866372025440819421101419096130262833334835540715594745203497928587186135275164081498109738970466988370947248021940561569267620357247990127564522986310964302145369908890660449264056644207793236365779701206104044990477997231665450915938672520424793889210694810624411470888001317591509195871138123000469015894328297497250904719114388567687014851744556022442961196710095908803781450379433402342584713863662733623643441689857131014884602662123464492337174369133466448264027859891983164922977318253912655776301938429642424778867582906519624227348305316196038256878407292790591955344479680471072402324010158169055567354569723172769190877672951964368912101219152372411759765906319270742802037025315108184220616308452895818295274703925043937150086128138944694334690895715466059115900414549791022779466329362784640166027234315398531594729246046165414063475626337644311168119473977738907190769773149753444889050744483888527031753269201378163949391709413651666897797490485023144028186137767741791089999062643796970540763835159196556710502136344456159146463536933938724154687812118748423317288896029240278208206791413808138830566223215383668490712836511979789759444357892437169498871395492267804755988157001467513129987783536185770875771923053130987057347117362823780385689648919014963047696716154103470098994989345725145346911343117330869622119951903038150855418046253027765885886218724702925936410282489185522756032811268495462728104220394481377696603537335160984667864986276765977187399537836443085495038531245967953961552446099860202534436731235480471929808561571801598918155198564810080739873500385945710405482112632560175607264756297899129452391915180568328088485838613446311138823475039154449913060040816427423770182320842215459505602354510096873798063265876785081356998835868518885942445083354431087030042413744309525326328220678136511660742377710733998727292745707370149306373904367419242056538041657434878135718117799524777086106832428142400421490018054655950412450439857299593269982159011781780249398854270083773794944213207659267485441823359299446700992506004289705337842888778351737651779605231181708254746601368430920419881902642935177367932998854576692398344459751886887735829064250597802996656701490230365355369225581279270249772271949149639461860827802265641912210373794387120913659585876224016662614940202604567122179359921339988521056516936691652006240649184616554217534071478563626303177021917752591326557785301227669163105917409683244631208728482866703251108862408723183744042296073294274161196508055955221651231699708090352241385134214536085190818421338260209629918128591434912063026535730681010644656403386618429547404052795240075086860187459052160963056737815868702890955646782749961792102957324386617370809721387526698110183742455733953981182952759884151572141705027171492043499414645152188830773971724799973332509353108595790709945881172596837546820878951487380925002010056884595226889787353391846628293213796727067989542301181895922192413766392411778496493828628331035157219992423196317772035191250172742341217161836262465452739681529087691057290569734559011810374243240074915312551542018079936359810781541145636446725010374735084950584360144726446720926696331998926356384107275533042782430883822062919212435434552698245126217490533817082468978688780544758069017551960687387383402646311734608027709758973360350438485048217473655879910122017479124487083984553258669357644268459723680386444644299296815957764256197895707834141229331696254986626578661828724285209849122270741969321864395528491611471747903202802149825160870101694676479154668058025101661043247617744534014911396856499059152980195374402796171308065201890403312209977516590331309932987450382792966799136575982806344325051697044837815075797093241621255848204635145552752290422425734152075217464598255640917220131906676607347543717411430084118789941845539181845481895008930088049594443993308924078608343731751939965383814322662743106656697422670651000816539765175284530653551633723097463047676787407532155828486263227480987102008760594072693502286938040246070625459860254232851627122961865070654207574623823566216001060039094567209209725775825763230163313156372152249117680129192602112089132327049842852601961976981006062863984025464025898686313440359127354951677222850947429926989777980273900004039886562684126073429162796768698411938884038265837661057240916701298478597239214805770700842310433207243758454226575560507638347245292921124662024531889305458038978577848581883521595124455052681925416751447066267898350475623198077107362684955144249961692447522177941382898309343531304494881546072208160567884523105235883224402893892054165712799938986088197540768900218752901908428813825898329727986194160559396040580874580592145221267422816160991357637320389409074269322899683211696307600653929773176805460649746283139090847336334687439385006077487607666421866453042325584755564143794141724973885110073797097675488589746812806485435011501290817978243965209645254186955867785207854238375361933983929990866207447166104507545821297467956723216307431016434110279077932263298146726920006405153359753280406882625387737766692472150995071447654805286708373812476228265743259045685384008723820271207568824009971171597855746303379367886311844841744295878805620281544448482172761097120290898991482910003172967381877949521969091003419151726549479820830731775542783902660249703027452020676482279039221602185357417342632823460605304236617446377384345813850963451662027388366735986127806341556533258165513708309144583455565943708666189247528368063603401663246949817729001561662593475858640622640840056408070933543093243783158580089507732283647055351335984989557874608934255658907294146098237940297652852895833270313287669365450480938533527966069626072773767756648249770791584303973644655730485803376750683211835377718467529226424209948716222806327506490493314598414788759482497186371297693849540921769261793620556971350251387256480848728213369893819765026263678487456638461029323574398726018992691926985419489868340165449744904058462727136271155999143411657372559708525482923131487827770672603932766257340769574374502922725939595285664847531611507323044966193781365876275497902614576922159102695015685674154468995283354361835237338137608116116198672491070446681385918997493315286300498444032738677664587815706347978751626414178965714038553001352281284108538821046827856134935060671709233334111368405974974412040285721380785914343637088875011632847877771262737275113477796990360879091960693695121439492285077059789885871459591884525433838503263194130611418578152500572459462704535207635612947953403760309383009447155690341928730124575976735738232265780510121203074730282834486365598049961842862893137165748688439073919593711634520767579248898435203079451812050094365372065956049783008576854703831619003508650758189667488346663444496169762585882451334886243060331224028517552003749332251212766753339899118127943429902767870727107846365283582900779124252124750219620460230169433724882294260475214005933568506936797453183248342007096422790892210623497831614617956861302155509146896292911523397874531510117337390856597068009277556538486383555806042263048828928575318933393319908924092344019228836062473414094919931304322726995860206569682331555737790511812792009743217400773968593080500354380552453883654922183438801630792670121539434345646656131319741050136108826149253491661618082909468487012902161077605158523545427782253850032235619166826671310549711819061160567997169326882745715392292538784766018415190916789397162406706592585816829557388557850418790912578542235949518978147484158728081366956306927844382637491780372306298659058287124243738282188514071939282232269752913428982815468047762758607723526018649930198885938422813730672507257702431936476796851845098950054248184104047384998728469514406167601884191922466977894095542810927183534800660079899732109162124818685268636625436021426478973445981601123135709996702438818314022508034885046376955941779499368673299744092834388138989059386730190557967139089119883758273310833442692966253748075552543907933311736107135891195416747705716139595915388179391206728900303842548932922624708689126180437213289040147840317380133897515381528828508168553485753747721122160808210913034719036267324467681795695823739363908250567641449359853201484258093711131703808067410859040075163269791694266891082457535933260786389944976557502465636934786073515078692732154707261139966511592283031615555759054487926334907159570679478494520848920025890232811645122829942459559431397553954060100351305200960509751752530972902474951436292047937015560238453729673826938113672829626240374827397717022820982336855401635105956529076752381790670055104001807482583334904901711080893398496619104131258853770519254295420795076743954896718723337416810209472856657417631077100378096955518583924110956958696224821554664310889507546423250276052308506292504962656590040538000547002774784920205280026682324518849074298903906264818873071710235382066957793973059980181583370042792801102308113300952567884507093694059114247451777472829235809601660289662928614116942789296297518495928376771350423034905855655631197985964217188922798605989747527264440098327710039208472095149853104319257571883570031264574410489217568881197408593861997040086570882530809105118979935347999780981886784060210981486246252761978182289705631063277776775036594491657417697293243232146107250637208890406951596888440486835493127139231151727430456795" ;;

(** 
exp_e_string_10000
*)

let exp_e_string_10000 = "15.15426224147926418976043027262991190552854853685613976914074640591483097373093443260845696835787346051158726885285229584108349266426657649118779479704154810461761622938836845482194326518823698067581131232299035461333833518596595421652507204871131694841248837028298101630940495747791991372453217285387321910680977914733658187699967694174778649038163390505612049776125348054466629607940201952987727518553087967772818052753593112397590600518880880415176415426322765396936941928168141804881105016228571312512573686084170502475372551625472847514104579964933464925837773299779952674620708856662577940458954490095164618850324515554327610255137933371808546841479177132354705069221261463601385181048529506633592057554140009372881327566117797604186973016967248716534292099367010215040882949959750661761671984261557111132629477412381031515161306636024230107996709808256269204109446573037898483398872601189785442840845357010175079891896514039242984544488860038406071057436135092697254359616092967488612097910670894384002853513544087139188185236789558583228418697655027343664295059301685904163496485609333642048395482065038492458019394995077982115096487236837304006387008316809536302782589537327023103078378470655932367110570226518872074112834988818567805739016191850201641602965145319622806997576325541488722314119730826099368099555364087698755915274173757111587565475865680217378498163910188000320222944491499979112183361481437022466172929973919532085319243122120662170215474152906751373374310528196710807799425901987988955668469995950647941834081914265548283223496800308197268957546605820632083303355317199043496535221410877417332539633458040078612892718036148621553061838967714774681455173903988812229626407934215525847742305089454853143075327370624688814742087111269579631880580894009454584975080003845460568006377253481029113519883250559483047350831060155549141739674820166962646647269281653227703985434173838725723385537235346096532699531995354436041575664140135211149918101598562866411214250152405529647896191413052812129961336151804153574833597099192198950726711181020556454956637519491464396143712548986653702413156736247145440993568849661609368743180791968136923541287030124828551915902724703191120248337822495658746958393932826271796516391042999791759950682817945705010877252055249481298285548930025277276850193174562142221396559324668360038084997873859032683436304950185004282276871542390481580121071224177517284061471145880819134935740142201745456018252949470567744935225268376925303977835265794403486044171894933825392225727606028068926692761643958732078703464498541458890048607492454486364900141053278809774177283425183433236615161903431661330530232321909162962463122615876793338418128683703313656110756785714362533380344155735038075737094139606771127999463629977306404836149275182226967775209072243218011320561054293743249681115048423858893482536290464908087091005065244048107876972902934006924349492011561684566891525306919296489225719430373453459784234205734061804455652163311734386767284367240834343843596980625592496988112559166292903339968399425242581799454204418866977970028272866742617161383152828128462993809756795695162615405046258210563346504083597041156455606100143977115423103463033662486929805646359497997332809737823297085012606425437210604387439843831077360734046836325703433329701451799891790594360757116722171377467864624553986883216715147972933713769653062572323954258211409767582212783112251466700945515279072003798479296836637853564843486728999442845173411320636606097227961875644951905079279233300138825983875798369929374501323416601257545833031684768843688847837769013333485765609984797483434794249991091414576760283020321085917921483676306289226043294403972140781089371721151043959646533016808589004394409029937725994726225871128505843532170870838904160387994670787736338445296192322459808308083701405128436010138857969384849286349647320281790945755371438694591107949627453702261473627885349799958569070926904769632677811930189654981352163669586406155036967207570902832700440072017400326030013505785760312989169329943355479407665500177260479954112895336572857882554482039718922116901705771439261084706731865796851627908363481719788082194861444253539597245895561144883532869485433130862741322978233387297976254474561972008282004448958955684679861034736398354524822856857214679970742080543924538882370374657604828955043173434580773594339800500439704660706416691956740859374496133170865588087283960109455113552588090589639158778595616241213523388095928664531601171638578922550336700508443003650914440417696612546801775714964761998991059090958436797931292894165977577277554033195883574337488042018216365885539423179360841553520316262293568595664876295620779720832991284838849498943933742591567543093072970342416859871805528143580099650224487426870435963085851062224195826502549434401603236644913899028165178005038912766704356593794112712214875952944344733046070680681512427626012020888008163486794530071768513233766356495723483717917159023555748418507696459807357966208397228276282303620296196538305188987235502236806704343244938206167840763841773446925308262972280929377881185174780795798792586178581027583605298965199110678382425445733716415152152971310070462098551833828099405950504869307647476511065545683211407415662435347753916789527331330334471358729149015956537479229719823329044630603029553971649957452761931691336815304074037234340058434427571133271929751147779506617551125687734740802895284289868838379823727283638425717179260662492181586437013459094378838332360336003350150075182043736581848151750092777997798095755473768524693850758185957890692130436999137664467418703788138121987944258617740320932513134004325824129870332725156377926908578311103258427747412487585672471521407270238266850932424412188556925560886219024328632100456956683175375231972388804735988949015569468005146968259496578426360490896026561025494729633608051393082731029646123850973424053876913537847434055622116856268065144216104233328515347733249102855508432983012183676678468679706390251727674590091149137443761021269650014962550644036306120853925244729021936200156948727112744681197318230991853095498446690036999183174694575314076190916327674816984550726483645725093952000988198486296296772336362994759176408926183521377318634325445028960466366391327440917029604016544109770103685562012325593434036555700710593813921515912093598146003893089804667204071522446952457592030180467515463964361372549943692499863535290786661604536706689703769707018666351443635853704092243257967623744190705310396274885579259809553846357215187180773252212355695711615110033196447442920031905606965367105472940709991245576479209761147070992304706451441857811406603602842480323504624988531061112899055154702091154727849213225213415581410212435950962077520282711095344439310055024461607709767521495851936971479236865894563772250148111978893433548183200641970769993366277669451259039554621032492762734014593697766958138249712804161323522152530615618798014735505701594148092014290817859089553987325664847567138889443568182703206964339297644813686230423961101852090918263176061164852683365491363339904474626360838893055412879983254934358082877885332184361481100158095341421679297975536615409959705684738075607920484997265517126017206377635876645113085143863237785286965886864523390490236484996981079028099930111014435533380910577611595482007446857280403179214573388318305300176854937056823205812750734544559385834467268516594799090042598693727008528459486996809339491136524565933257842820316662858943418478580917039670914359301584782338538973737487685085101380596736085052941768915960309207943306545833970217071312161421939808924849852190173070571013786885134662158804464311910866740832391553590102217475313144663215233483029451963957653827807362604188690218688012244444517051238966921701538685037729800331698812417830162622820034212301492713122848251613078784069260119358956931640445693702084734026743579774052949892583208295181873235977371643485427277771833865617093581958084350046243803726006576867715178413421316550152758519129758711120095985488857364865802931345985177696720061116369996033316794060484277176734829435099469126643910286429516150056843585834177023910410915844491777583488951665403757545648936604054929121730607106067145817385471279660115553317626973927661625913772538446811377697153502883499721990406385029650619076981060495771557181017462990794638214124601851439678650469796719545080728552897388338062232238505484800277414896067038156224130762818001233876316990767397748236612842765074718254521579861853697181243630745854391704794831447957139455507672683215780726256701260504474506922422986640744012648354766352251343096673315016119541107881153032275541009008965537682213694698954766652700629566467585674112676113770501019068306551602850182696047417762998577162081631075953010492955569396718801553631430143424430731897363423689622799960286246196276944613586179692759538317078099561045665970567794014463313146913676028118384664971853749412602802341653365609019838389746675531499122279480044387283019790071967015367047981954892547746300353893167256380435108260321947820764359600104076859988035059560852794503023411541560225124478020124251633255043486786504679606907788574890630460345636401456524249436888434198029052975083040198589180878359264202618636244512836538478871803659475491166312240690007182640432994381097927760265494403419542949485357051314498407759243103197176779548276502958949855859529366971703346852914836757858125819408123528654562882063398243283700294346674818673428139897261558104997895979766596029089721911320459331666568669706771246095740565669490660484534697534714914634137737316685987736430435145571210473762551934229893442691941638944404620220739464062404347297294042464727664028935140802533862439327831743373650314214835881481657302135289670478508166343999262323524604247948223663055673516515718162454759294585233853635073905569664688672535990258287306553178016982528302988883986435357183631401375147141407172011869069925803049126007496156648049114802685236104418088396819786811" ;;

(** 
exp_minus_pi_over_2_string_10000
*)

let exp_minus_pi_over_2_string_10000 = "0.2078795763507619085469556198349787700338778416317696080751358830554198772854821397886002778654260353405217733072350218081906197303746639869999112631786412057317177795200674337664954224638192973743053870376005189066303304970051900555620047586620529435183443184345502747974534476993471417238323081527148180076092107419204715187835348958482189018602958233129566295207082340956769636374203945143939418386190108082089777175170500434817645475171452989434113414201756221548809541992091473585152856795345269763049937295772948259970284775240324808207770291871972175383475208608648587534778655469838325536790138351722118641519595912039044480226696736794359650205584360295696065582494313369401729524289610861619824999045135690057364051102664391373517406279074968849012275571917762037730358452877575760349503812991539865873765359168640051599889710637990616086300309901364570949813814380366403489134562875716779926337700074958934442398029209326823063252497856169693490834025947248477168094655354769168600552152101721516829611551537372040423077475542876225536015129709480689776162463293648732299557994622366756536475990178824240871895144367239501444432037406900044851456102969110491087805725235760912241778918093345844866989075110241159625211983083835064449999377301428304183761623201555128748627284330325807941818087386115717161488671833873191129245318183075008623459188763682894433151042137474732798050332879572586754188042794246008255589310591599700039565062544136458826646603112706742231030553518790253138897440571217985610400661375958321766554381006643172372547296499196185629281299953943923577180976606249266319145790011078746580984428040845180403278067261804204126406596277890674098942446090245483671411772154988495694045211248591278732113406176638963629838675542025658787201695119570836855982786427668071888123191424439181121765202350076089656434863675930834706316984339634276238080100242782328318771522225364159520687815624835626257146031466580923268490357469705015896780235202598906362298218085034406475961358859669316574445307943159311758650067172999219876372353694922217161225809373554401941734371869503950010750868223710283529415749222661664968401859539296898374297407142421954727586194090952586088768205804097581044254863699457003439070964565530765916238224731707509863068040530909871916830794403624289854393222370356640450754542286373794378193473407737658296499339768959421133788417374054559102065242207606990523871885673016296715549990886300710127008555967128290289385015628253323088018015298011207677861952937072253141721728777940150274244949222557491732131248880639483612672360125260261524839722192631613597799590096498569842636356199825108322075766069466873743968403849901724623925297747177804871790364804264979568682303224849142181502322907312729298776582232902504255339262681513657724330830230566269740315614412070879059302587453584348020729959485835523641684224480280322961048871325127558072318187716111373040858500477674822378252687045863049356461685425619402855920828034796108698580835318516560886423836807481924520985276255545511634948688717244020291281529832816144123449107199937894201937948797252090748836878198978908670325018478976989662210564636801044626645697357775696582048508107570091714428509478454475203502731826362010397337633907553053375835364510764475764142846414361121605193051231707388979562483489452195725871216641218925729308949197132448176730970641566004167548807613501777147812872582752874134078546185822438475649588676938022290192661645775827519481124706445092108634746723318697493207897455426405917678584325324005328681496656218626965415956449023861266788603410020292896513051088581111630299196848298963723024676306753920825884118590617109454923263900556695381735554492045292084187426912206403570800421227332892106835306897433214464113109885982924488019244106297299289393070552256566688067074344626121360187398524511561978375042445587024206341286611973125847518335955336605822635001435817660730030873742370505834832401334252614288158532504469634928411847480231595454077749825754682008312765965711853220703110118390477749041858244516528282774707113366668966743507185152685326954981567554277720972354497547841266640612526958889393230434516886102682415659733334343613403927880861018433001690562470906608704196778386633185799947669865977865578464689898436004350988085793819976506983860946552741280351716427577818434740389740342992088889179317031249079651303095239661528982039982028394655389468006477058722165075372515496087809532605409850037995015511121110402069038446069708806323363922917957635800056354198336539684002590293787131377624293409062005163403050895937316920328154232162200223722099339873290364903004611076253289363637441750087652525797269744698748072458176480260817275260989181474597918464962423220726724143657597856879888578240028618663013771200093460836325677244369407337528388381797502109633237352100737427578090794219670442995579878507350592028481418651077483431094130832343250031477541569175765033952164381312386485794728990104596261675164695270388588657698375725024948981387784503453910784867140808795379051731562396087328530844760015869400706475461642961320650951134928301689260498323130597358278711290066803170478656693996456229755090849478763767262888877740882536823315868707059937636239562753573704023834821760372081862270478991059499847422290521347691954357109685957260564564486943743223053616254268846957675976417739377429304401720937932535968146592873778143041167794656174063799058212685817868132648936892223664346511593106239842171370575739482038956958881762960432186581868236242197447899233165071399117127201333485327486932904655330392359592591995483557252289035267193884692750602230500779620008520252844139724657008706955501897326578474792481467901179122099265271579813861030797972115919687200830059056966412414316171482986905757751480034483540301474312585236196280412226225646079969234121154774917749625888664275619110182818485940765492689583506975758206668778208687264369182141350459441083986947617043625746312487444792390691113428178542595022472663416306866617282601956555312908928768310043682376433601182594060897131369699482057223986697569288473711267159148853076022101452515378251762214146114282586793310989217726183161394176975150192867691308594479249776197144033341393686389753560990592425414228833648033440453354787055161054594505654981221944959742015372256682831827596889251234286618604033459872860006018385387933199701718860653990356006283109880170436439604668077167041782692442986782070652427659693441409009926706623571764167853268288327192284367281963549562962204864175819569323280121966565280254584604522883530384696090626956285115171821395047511072129232357149188753677042586568431915160041279427675147703002215385785540183967078050954173183731580120657560170764150188254820095982566673941381388143357886695078007545188642093772470177719312229467377361437864462558204973514033841090775220218516510876470964939782232809576526412379279465414518025741025505684270003574185898299909108426560539137256725044701738916747861177847318428280001393154515396457369745101356368457776935744791744637075875069428922569231676952724486999133996276920312861491600513332703650007021634101361071989744891875348500984232910788234038921575897937116435872392684101800088234846960724534503602981664634620931116879506370932302067121094992528360474603857778917791191497107070815012564897747935226124450525350273866926498365618266275894397972867099799606274315140534391496380653382783623106476070420230920442061151011339286850144987918407770837273456435248605619884567503872822256195544785659180488773863175067810680905955816580773148598084076016002059205212748209072034720743100207314375434323393737538056924780735532362619480234863340612325061773408724248163801237941637441089952683625308439618192159938457115763951663148723320455191768590112980774628730274909123538800793325422360680225476036976487034625996138411681075379964398745010569352290590731972098132354236609833539298757774950837313243336863195037527329810478934340335426250241720243821401217808992860991612366597828528235357814403789454092090720907180939415317301561592380221300806446626803705564925450170945041536283954158290998484697799078605551761323451270010886275283217608528800544569416573836340566017190285860827155897728796820024717736665364592462086850758667095348675719774422619840410041963809390026296482094625810083301123924298548750223770336599432076587980107202746022994568510892744088019257437146465061511249977739279084090594239279529065704377959294346795158129439938852831874926531663235109799325167002006051565744190914191873119331166936717681865455527848002951059337407828362796560044632810723318340659065422415977138649721275417776571053982066257988612732285104590404738700003297827532596560798009934636075866401407795396880332625057639542452396943005718790209279621334287560844826416078156482278697718247739235488858241860295589448399131317647269755482090703698301890431744886092737707622863850291351970053795488036558451516523187109978120702294647160812840841762680315258990134549351358704589889954812748259596645714600651001637177165227333747917713738176451156098636437596580981728985743266041021045151842307715548179107645721988213561713900859204123548850467331769488637666010775786158655103273406699216864787097749441973629221249531544377469845435749889901568429771782459339310257632031468124529513839697190895457603771780151683042575277628382281531559211288534976503646123667770327899192341899026038428918367629363851224889952292248307642284849447744913761351749856995294791441714467262456152903619824336661384680468805560822802428227817250868262372735146901344786816140498851008430025517435780072840925791195579290666231064529477772468159343004812661601572834021584222841400480662621054307525896749256244501655571377023061508709283471595207912727571957858880278241567304398823250726631338324748134948190958231161730103470922694513955087252323637807917643602525187907355260870570639910189319429469745194156024294392394488328554976561796265801955843311984289580119727" ;;

(** 
exp_minus_pi_over_4_string_10000
*)

let exp_minus_pi_over_4_string_10000 = "2.193280050738015456559769659278738223461637641994272334858015918657026864189236934126522812578169404711677593579076156946470416008507626053773214988257663718052975713804565978727247767674476187553129593552530565612194193832577193307480608531368213896175659876651096643655309151205704535660983653961655334645906437350207647836049591361735421529782330437800228829623058023263786078423374274573570202288519980906060551727339410149286414016982965175352236865011817966764745762671860102461835403114018528387795764424198721153186940318136116432809523073002439804070566222638946943571961144401709663883569352325342876568261223459595170898639075240741302876660357599087695447183667012244780255732001116592048573748744643069388711766716658742354776282255017970455182275701364177239748416993429442894102234360498748470733717783541896063465911100444358310616121396273286955705903527536857423868366308172203012831252936217554591871675499379794762212917392557593612203295582175073914479096748534460535766422536429953876532413694901848277429269484382253026222686137292180258486394076015610981830938457006947079564020989419034534983781907650000100611684716509819111070381839772384763608664805638827599125555042683535206743064402411786974968085658587357117074365713678604431539475006457618078514725488595795133627166528375969251327724312294651755004856518797356825401439024848046006406178884377377450868944362991468907086397432091842901362842265031054429225549469651884281222507925217500723992555102958263503909248627335248691279830991106373430777959831668442499853979554812526803399713001149984604248369701584441401484198230746002048953718306840715930951798322532093636363858156563347491104185919433851212535131827019662743860551830451578178536847252258731837875115429271169298575064161433775971828117329406479177584800589630056649230988431117343985793360463759001175236424780925002413166820475471761323148579597042585104607079323249937136444354772756031324535754690788618606450764820868260073761233320033982226889849448400341378694746618038695372140151016803762347764030051591235262494524507411986512593567677436750533352017890625140511956523692156251038427124391992381119763805122872076304803166688886925689947829617421376462917644984572655522051325714862343125385880958113765387524730057935787446438199684356480158850330947520575118274374162488668409002923673379296223869869685181631283180522384318645494281198556478666590015799720550724302214549528805281946422351124333401008761392873711612202403219793004984565292778187890460947949339094229508046100818352781762580008675075155502300964096421648252251880899251426685988019749283203354346011792947262218121817841780470785941780281668550887225239848910707863903947342764770322432589338715425271158585387864729707666856866999147813053071267699738220432623339259047815633622446955753326799340962777264997449190675870557867121709992284117233867872712252875669811396009143048184301126737784000630829053670408732976297239623954453716510678481750977931829045323801266631842571283763291423484210633951664353926479603006588726464349927980500624627371858917346305342981855648774940291954458504954295201800083779601533642976516765802040742983959025677582260320968377979305600045731575131819933254779760850281399383680235539890511028931831055747098928142767410505714796017364402382717031422846133529256919189593683627588031717926678669454692469789852009244489339689285339308033207488223045034038936001024331938155265437376243344507479317644079689973766091157768647145781875656659908467857132000132876053569027807936168522633033792087185227521741291770793914018381803269153762693322768153670629207583679573419468809973433544610610381306219773579355446249219837130593600229110367825719550121640045303322549730010081623933318133465360615744270759844271404076671415106357238591956259899632851553383905016143129439789866126634670379498143976991066370452311831947971570539694201835987777089135790384236684648785134682942944541053815405083367147098230380625167647210357684687196995090227364025981637540375533195671132757071211143153306171618877865868000292520562346395819767365295806456972024498469615797702741647743410338076076816929384297217111284349286598490991720817224270853786322971029235837157946294093495167128723017134010368151889819159862224196274429107997158613527055202182571799671365787918789998617621656217071687847680040481452451185363699531747803623991046657977203989532340283354791194310037958462900597156666278451479057013109667366047504125748841163188974621728624526955720027088833516320843738638691934248921065726039156237854949054638352751578792762833561036810409183474549513627847593967656567016439302081006377503585356851918969994938748865626444890896029429893918472570133747816110237652025675113403958116996992292044203446529501068769575707115554358124481594843947108897097990662835095565570067896397175272013086492446190222782360083221224826868298122337900611385448403539486430765197624817405785890135772923477379045156877026852715402155534945707467057598486724457201753863255416259280779644707251372121212736150778957214243948744060488892238420216055019170894352911447389162912940186788330747069676574424711463398949961098140511242654987780582105327546727669265327175615194527885398983106280521244383797500745475120642980015489704453884436861806588844202460510895028653105111190294010996133073036543431745371838886945889348531838539415665898089962897739475038417980402927665900056948999195650558615653800751452445469527618603831324953416850425792835356205120114088954477442854523337983721740613791275767198132821873114004063734957780434789060565052822039558090767077957416478018776101282142219352449295895587587656817076898525913502489433214376264118665504060151976498485260172756225987539787202702766014070915712460430601867246539644256762521703832508155423707670665540800171670839351787924018787114329537307599803710577350389312006768741982239450006779449761090118908623417273985891004756680318741174522671386527904096506751607800663721056503612259333918350543666143787652796185171408720668822387149741953273606583597241933264757328047558754580219708703017895802794553414555705739842174141316928860102526872727744079873518419525700606101983081427651386846323665011084561435121692587254975924466812005649470636159208030202808879397806259663579161898925390369720382706709857385724564569917103056972377206427365499175512347496886180009170137700856126808202201414101434504937495603163408935033512477249785298769845096301919399613992608207361658468132026971647748569531620868141473470218665333912086599500030314157908892085920670356989070067463813786166149933941584560281963650530484447104772008464938175652380206337958496866902323418506768893241732120247404120176578920449358965277435688217854876495781467410240986203378211013199029988775768738709817745909006953642910122346206276023423109772837789737254179308539789792675589782312308559455740793038791551821724511111655359372629883047411912237290741729144649900323505251361246733034970226873613625839128909627989620899550115086744576511104442090505711634988378787504086981023930072505137961946138123287390063301692450526536104192692649977191256117629461485191585948146758116651417041039881853898194892779014191300164079325522100494693909802192873533489250800751038648247219912087768492964018883119180728459706903053907546426678096385720939957487728482585582084248552514217506753320935423756713580703706274066526571393828074117816482980546579474500882353905634944261268034401275688453590401423287842216357602853447187360246592591798232097756853750474220488955005242527278823586595143079379557889865295015610951743556394405888707836394113639422427780141796585573646019724973208957614440933061923397899556011702042323651476034361502422164184700322831601750456302151690574539933713031858955772474778070300216923801337056988542683123106643280806608168382283895960224790218834513398738037956280786278783265112139847041192050242886051135448905611639502760273327023573497927657985172791422253402170027152665862649123866298821015556080770043760896119998399379677224832841372870565297196458380816847478802146701804973718647821250338477490287620917032035749684511816704519382646013647759042287716866480782566565931700823841719619547268758407056584641330599541731706998659906904200740805753433648418972170153685499737300884095530866383811155393853902079791301591788663459935459840257546119121079250148367919732745530700745043499534595133395859863774226737793386919685684128439374830505524830247788569448980660136612222741771364269687152347399916433280025818881292699210136408940064569824053002187668941872401802195364015742593930203643798129974425549794793966536912530260384088662663177192592818641341815242960215618331987140084186231203981489159526111133076472899411962838446437805361650957064807199611135494359660423147617331486992960336421279670699116622806260318711496433488749401131649778383483357895048064851592881642333017660877932729982821795719329217785944583082106490785683003798345502346955048271899854010765368723109900841287193162708972002989419228103997508887137507635015775233268819258471936789392626453595253272841613388282519254726504230174599009003862199225465183095745961614962551207562179971476876714995323213683384576557774450374829209399180941220845195291018426995993981761367080138367496296388603623232197205831662895417412741672718641451668541841445086546348191107366352704423288605275430811102826706616765588914619970448124437493409373908877289623710559902369796854332655840341460842629184000600573599748188907753183477947246351769977040912197991965490403350003165379097805944010349925730062015509510255743659275043613340270453296824473328809402555776564539078872005443412274626101252601527020876514643478057405947841926392101141702510414863386346506511630458271822536295252010461884810529074207081080594711247870884268464722941515085808404295461553548108557504440851363799926985659867884887429473326789924041452397769456241375373494703623921977588681258866719177426067445885780789953080256388" ;;

(** 
exp_pi_minus_pi_string_10000
*)

let exp_pi_minus_pi_string_10000 = "19.99909997918947576726644298466904449606893684322510617247010181721652594440424378488893717172543215169380461828780546649733419980514325361299208647148136824787768176096730370916343136911881572947102843075505750157713461345968680161070464780150721176248631484786057786790083331108325695374657291368002032330492961850463283115054452239990730318010838062172626769958035434209665854687644987964315998803435936569779503997342833135008957566815879735578133492779192490846222394896357465468950148911891909347185826596341254678588264050033689529697396648300564585855142666534919457239163444586998081050100236576797224041127139639108211122123659510905094871070706680635934325684092946890616346767578519812785089761055789304041857980123101280905543416254404987679233496308302396952371198509012175432057419088516489412743155057902167919927734272964964116423666794634333328342687902907792168390827162859622042360176355034576875485783678406122447755263475337650755251536818489395213976127148481818560841182505646929219117214340238871975735302737053950135614521828109104597144575502700523186903590221474139961383100710811430967159039787780347029503541465115008678163379586633861452446380120236118447311189003217918458997751874006486925701712563117876656009750211661344400252898297844399744009561389400579374513678594182604247884129677148623610697515038878982453729123320611366068432247638407335463922045676936744562236633624539931881200274552883053089922802466443561351864859553348626490481338875979430061125190962586966678827772107963325527350246316244035643025758690834777767649016335707334780928078352511810844788876263238963983355886369634558207073026453505185894844644741241431636157431413501230461310913990076289387960684089182255337597320591952399900146127619591339991851588856315483038901926624147884649627895906078445076916784945895311880761776620304673557229027697310566371574540134843757722575936103211744454181985267226270494672922576621203682085211907104889966588624427786302785426642669364304264576853408159479687441560575548943738448307051082321630830636890327031790297591696106384520373451561664969901563524497462898141027381648183554071409854243363888623002063958840487880750553691292343566589039389947752745074365146220752109401479021912308525306341212926181956188211758329323149730566323926500458235470111691433314292280678253894070564011061041479369459734437469342992557738908186793413190052222575001123645964327852379365625022258566073651146403576512933956562646046651797497819768707568772289899632588277288036002000170488639548721264925225219035315066350949480870978241950024861913958280782433446552836824595306685083523937703447885981989802196973831381835019007554765443499094603341594024737229245144609091288923429895683549764307686702856175029842973505186273487977145266174785635650984424089396365683121364030265728994910008509978209590277690021798006223142206503383612208941995491034757658782081350565295245126706033794347072724232076532763829700032136605970723105357516770970777792360353812249537026408069470600491130383666392710741239780980775629516879605098581525227914466035745786040764046280795435686652374027754759236990437929547250950445390193731549655867224460589608837519255601451602377956043442800610033835366668711138860088279248530587158615211116364289775138359436957113096209146290309501032918518763694383296741127278033060863448990442982740375646833812209798556171250677605581397969766010196717318836481390108908213470254237658917241732256602002744893677259352252878207134380436543705889661969731765151811990420646725920604543016894777661782838129413759446312065823769875220783200515638685232346213584115152026637129120428577801027886476688718256165114025324034016906849620837122468038485922884936787997307422236449165759927413158739042291407482111861572323526771412205331259252622793100729455369030593805887140493472407204939822931805220244526606064223141757342380060478429528373707402900189210700532142258910592703688727001426659158040367686902369602149542522105409021622695867214890800740024308751919693917221257771496962551938478247779249473996238196074332286554333706959455418380003626410663011423656794159448110581616199934893181612445685394622517622019334553223491810616740194607643963366280901074024760808027599037485238704658280577787013381467907756277443770036274185940137135752576292304806174906648119967806997797577133289927117885263464770402691646570271835967253030445443737137862050860502654477866783564325971977016663862345921121265625602821476034588335709808785177351522475942136487892173808228295859535217098698333189190644379150477851612896905422839580246755662709563481971735634322983875043810396673170039705061561365157573398268823069721721566777615307496698550322091223401355558103726653761387802809594750594237366677178444167928264892547927013372034218361274446729074693053189338515105633649143365280271327254769975244253772238087198116037504653807453303290088252194510436883167141055206755220225628288708175168809717828573392343574098128512267650124642547350924565619197847060367572930562411053998761169848639786561341461590447517696265549311489502483465305079753480473735532585271954864935328641679598800678629127042358453794984224840127957181124260009797595174684525580025255353344178731374365246532276078148082476914343562775331597642397722662136560324495289102776755304637486132729661127065382715588183942880391419283936078771113014275324375049962339729937865326243049115760864674066260639886939510050216961458892444914957010282621954048912018141503375643414187239533825811357572663495074907376846450963231361434715521848173729466486117175837024250358316677846092883192696228204430558058074171289337585644009458258784804588113581992992515188462045371299592816565170545986486205574505593589229190290759452427644242856328337047684784387710084285806522811438776340914603246225642539987600194765105968275930787433487341045802537443221221204539220623251788838524369835801344931383265008986858624842234712069692964710923847331610256114089684907875378613111602649149183228201817705843248213583837954197180088505551312155973970451815744815434430986386364410128713123939019546602780317797201825351291474510224829321246947053267019968332634417091474575939779774544220701974381216949922392547634335403945375440948160298106939028642960029887294536109042815513450186437843389837451377896734874563019115774710004871068911095636847188460723373823021858820082767916589068772437562098173921809841651814317817756631295157390952602399367033776419596876378428890428795033822575340803228176154566103901945660834901511417112718706883311359797119222090651857431684820169633772329882893720582112310000098669395780220471022275890664274784538597844887941302383677788012860719911506872162579277667951115165138859162956202349005887932177722184159848802130238042803885397315986356151975149052856234638042279669463413695872682138165560614212585374261265776583928603861943285846887026021583226342752879123311537821933704427767693536923087115179089418366202882612787446794052833336695647757781041538981809217087587446645287506855097348880928893844714738029909765931750570442244207684841669358012368121822844018786912428371778991257656530107152110132289030088054459474612050552746800435808896904826696436897661058928418031066976927352498490965733956414760062988140674769070824604683497932019142770211216382115350751118097238534401657443018989446969921565069933652630083457772367984644662007220753351083381514646734563333717540731357605812669928330282263009771267792766158225770600840057706595097858793407335841403491886513424971799301964253794297194008304223171596704106663574874111325624044492810191991023602361623907689577461383857869701547415520709226718359021426284200870158484362053690572126638995814434839199443518560460931407698936876849143575628692228860020779834591413407163972383801769941020895084118294944275875972539756413140092390176586611575990039984880518356109320988062779620958937415504337062307232075382061611953644922331535994950669691104692518023856418402229639342079353219494032926117422553823451331026683165558988111403839201113565813296892750146247914029348709039807349732587001506044324733014136302539001080496685894919442512102966393627825898000258909309117220888703347482181498438690673154011019656697759436213028392347249871033793324238757198555362578102235223492151334260952973312554117510749132680840181441271942280024628207220238575404723196525133518873166929605566906376367250715350752612838888495182988849112714923578903920089790063198961842534781881388447686755443685336227045133322775163873039135487576261839989903525938710959551590628917269289100556440943974255475610736588289015260871414085591026918713446996993457135756196429787292586178780867235151808698684649765874587343518813459047217071008933721415817161725656035654104423018888977479604393276300439586174990455328492023207453852537855223592926112759560233683242011283412028110425630217924717949668378310694190452532863810694375241830037262560923763121305298671290587679827186435974998506300469508702155038456994418760378042458968150877688630541699034029065818813216712774273658471086884856423592437355172726569264953812043310009675704410589503576902118307423711246094756214391423951581089939727161585235797242641101784909306238350065797216137891743712132014275467241796607604789003051992714718145057212938396314527064773342652372771941525006566491784979773703241930160061070897754758450189839984139658792557105944999756514295502176675624448821680882297904373914161833089972638282529253587052974510498898986470188995896198284718305485770118529801112895680553893898597450382389254357462827550342716721187465597720959890602789334405713023853512700957206120815819007082389528103022031073142619043732699537973739327367760402076409265388337704779509448126955025327848317338719339296191983626843057881567118063915303074900476642721249604317202204204405833587341392328955651239394025682809129577779098483114859945310272336620464603563574117169786115081749951724661086616726559512983287463476860" ;;

(** 
exp_pi_over_pi_power_e_string_5000
*)

let exp_pi_over_pi_power_e_string_5000 = "1.0303455242162108324415524375441423913311674535426350477520603769436858333367078466536634299653186541372113411215861485309267528306708178141431148217377434464491473535305791217064585171952378312515789548509946623397488705415787396598914128956695347553752512638550318082771091427083769596910701526504657102657014692869502510623838492054960512997771472559153485184037328476999471131102482175108766705405357550641075673536209065070065612083371548796051824396699408865713070119453591522563130261505375573780321442206315118412633701828205392108525782413195330127295606671997427108097591179860083444244927443504416473570457716741027361944790276285858904376391561055460513844056484484786473059281875288705999618242118516344206637486889073335672784807640819659793662267947301826094178286628556298718293181640871018794887107215120378358047902368736163774600113536888571530806116406546769959374670822838831591995246739397760825519219044581209189563299741163333901285277924920149254250155930276721158235118621942060338299354365607743394171754382061635835272405348932946679933596759506206130017828475418918307144940475513490382184766259208902019358894045391798635226366845353986660213506300136683542452360433503100386779828377194524296055542625155896201660418497249857519393909560624558632629048202033644366281689121592387678881466708494160244123443969487101080773814163290190308642637831152562811640383189075397689915944799924227802820597339613777217618561872414351518852961028021385766506318313647757892581033045358424301682222916753570900972357163617240013762911637150400945037844235614686034985288108725562841450786346419119390624812221825328995176975683853286998990908726560913403463381959725801423994527347968698791241497437030413754666120748996538532520334887655651418483829786184423597161722270484841081182955235013642599171601561765340982113008867892373066438184565570446148574659162798044158979615920484341235534722952883275444110031732698409577714894022335747270695034795634038259808232888752314164042636897649246376112966084881564174430911002194621112338014315943475849993253693911562132079916221607184607540690435986640618161747515356218190039337233572935696582249926028315761099430146911655563864857416275076032044347923388848142554142906113985109440285581930531623657634308474990763926306768429240164307679991695561641680088484671973723182260492115329890676671921181768396504254870209668501199334205149354666008748500702341768691201183202344992609523780286084761690343861536796349768945736239265225739787358606349252469395615406834445993226029487554464297699427306738265780451031552386845364653955347733313540526314510638740341825347969180109919029632108817970395709236974509497235224597571094097524527161769350101104911425041611981739710513051959010831221134522203857233847555802871623984436861146462870818853663456195258346137495284947492306937529169502943695031393324963665985201833060342985077396285551888187518241058400787253270250272958053402063324590503383431875148063187308271470945941099630055662044394841408383586211303076912057037121410394626302878745178801722643012257344184091930314299311533613670511086287686820920125254676548794836152190342486374698043530925756021315272657609592704240679634030235837731337678803275909615823729242225192674094034733347282408569249893066096625303665060141328397095108636559053279206442589687504535880889945359130230357553880526344163933474669136540249958598967304894454969994973686179720170236656267116882595041128515512137528386976725830111755568008737054028534145068938984220262218845032385122987196531418388634356300400079754399323431341442304427124737261820791958803995504705727237347215237148960842158329577928289838489573859694700847228468801328852769122857764983181829850973440461535208910470495630479416967402112685922449745370675956600029999109374634170809368965092067089004760620868811105122573206483946934074870647271474816529499650591479090539196087350035998575551512265110378890966962155989784295578989146322559196913063444482246796575814918920116158614593623459626467556899995466625951638884903500904736558542229343754725831824418785384878760691184801055946147381199143107318085061472979372417452455421013474883240640533401002210459946434880821490561894114819029041310952666878117405824048833877067798367872218550973074809346467971654837304951857877962147536847921083508427949295933261803878935427064243271618359399189425558508251059495174229175881478808366175592860651997797451574368940199792436093867629855944946966838544457124506032420103989515862170043314092633031761726654316556666465991332346103238122328779540182412560527612095482140842524919591957791103447564919160938357811221198862926226304837933853515822584561588849763405163029557637771643187630390803954775313273686626229805934529312367248566349064704122634778972487844277782455732976716835076771639950329841273629235186468183265038323529158215101821493580963832505918169422769738793528545342531361696925447048232876405278904929373268347843062475293565301646391154247210424" ;;

(** 
pi_string_10000
*)

let pi_string_10000 = "3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930381964428810975665933446128475648233786783165271201909145648566923460348610454326648213393607260249141273724587006606315588174881520920962829254091715364367892590360011330530548820466521384146951941511609433057270365759591953092186117381932611793105118548074462379962749567351885752724891227938183011949129833673362440656643086021394946395224737190702179860943702770539217176293176752384674818467669405132000568127145263560827785771342757789609173637178721468440901224953430146549585371050792279689258923542019956112129021960864034418159813629774771309960518707211349999998372978049951059731732816096318595024459455346908302642522308253344685035261931188171010003137838752886587533208381420617177669147303598253490428755468731159562863882353787593751957781857780532171226806613001927876611195909216420198938095257201065485863278865936153381827968230301952035301852968995773622599413891249721775283479131515574857242454150695950829533116861727855889075098381754637464939319255060400927701671139009848824012858361603563707660104710181942955596198946767837449448255379774726847104047534646208046684259069491293313677028989152104752162056966024058038150193511253382430035587640247496473263914199272604269922796782354781636009341721641219924586315030286182974555706749838505494588586926995690927210797509302955321165344987202755960236480665499119881834797753566369807426542527862551818417574672890977772793800081647060016145249192173217214772350141441973568548161361157352552133475741849468438523323907394143334547762416862518983569485562099219222184272550254256887671790494601653466804988627232791786085784383827967976681454100953883786360950680064225125205117392984896084128488626945604241965285022210661186306744278622039194945047123713786960956364371917287467764657573962413890865832645995813390478027590099465764078951269468398352595709825822620522489407726719478268482601476990902640136394437455305068203496252451749399651431429809190659250937221696461515709858387410597885959772975498930161753928468138268683868942774155991855925245953959431049972524680845987273644695848653836736222626099124608051243884390451244136549762780797715691435997700129616089441694868555848406353422072225828488648158456028506016842739452267467678895252138522549954666727823986456596116354886230577456498035593634568174324112515076069479451096596094025228879710893145669136867228748940560101503308617928680920874760917824938589009714909675985261365549781893129784821682998948722658804857564014270477555132379641451523746234364542858444795265867821051141354735739523113427166102135969536231442952484937187110145765403590279934403742007310578539062198387447808478489683321445713868751943506430218453191048481005370614680674919278191197939952061419663428754440643745123718192179998391015919561814675142691239748940907186494231961567945208095146550225231603881930142093762137855956638937787083039069792077346722182562599661501421503068038447734549202605414665925201497442850732518666002132434088190710486331734649651453905796268561005508106658796998163574736384052571459102897064140110971206280439039759515677157700420337869936007230558763176359421873125147120532928191826186125867321579198414848829164470609575270695722091756711672291098169091528017350671274858322287183520935396572512108357915136988209144421006751033467110314126711136990865851639831501970165151168517143765761835155650884909989859982387345528331635507647918535893226185489632132933089857064204675259070915481416549859461637180270981994309924488957571282890592323326097299712084433573265489382391193259746366730583604142813883032038249037589852437441702913276561809377344403070746921120191302033038019762110110044929321516084244485963766983895228684783123552658213144957685726243344189303968642624341077322697802807318915441101044682325271620105265227211166039666557309254711055785376346682065310989652691862056476931257058635662018558100729360659876486117910453348850346113657686753249441668039626579787718556084552965412665408530614344431858676975145661406800700237877659134401712749470420562230538994561314071127000407854733269939081454664645880797270826683063432858785698305235808933065757406795457163775254202114955761581400250126228594130216471550979259230990796547376125517656751357517829666454779174501129961489030463994713296210734043751895735961458901938971311179042978285647503203198691514028708085990480109412147221317947647772622414254854540332157185306142288137585043063321751829798662237172159160771669254748738986654949450114654062843366393790039769265672146385306736096571209180763832716641627488880078692560290228472104031721186082041900042296617119637792133757511495950156604963186294726547364252308177036751590673502350728354056704038674351362222477158915049530984448933309634087807693259939780541934144737744184263129860809988868741326047215695162396586457302163159819319516735381297416772947867242292465436680098067692823828068996400482435403701416314965897940924323789690706977942236250822168895738379862300159377647165122893578601588161755782973523344604281512627203734314653197777416031990665541876397929334419521541341899485444734567383162499341913181480927777103863877343177207545654532207770921201905166096280490926360197598828161332316663652861932668633606273567630354477628035045077723554710585954870279081435624014517180624643626794561275318134078330336254232783944975382437205835311477119926063813346776879695970309833913077109870408591337464144282277263465947047458784778720192771528073176790770715721344473060570073349243693113835049316312840425121925651798069411352801314701304781643788518529092854520116583934196562134914341595625865865570552690496520985803385072242648293972858478316305777756068887644624824685792603953527734803048029005876075825104747091643961362676044925627420420832085661190625454337213153595845068772460290161876679524061634252257719542916299193064553779914037340432875262888963995879475729174642635745525407909145135711136941091193932519107602082520261879853188770584297259167781314969900901921169717372784768472686084900337702424291651300500516832336435038951702989392233451722013812806965011784408745196012122859937162313017114448464090389064495444006198690754851602632750529834918740786680881833851022833450850486082503930213321971551843063545500766828294930413776552793975175461395398468339363830474611996653858153842056853386218672523340283087112328278921250771262946322956398989893582116745627010218356462201349671518819097303811980049734072396103685406643193950979019069963955245300545058068550195673022921913933918568034490398205955100226353536192041994745538593810234395544959778377902374216172711172364343543947822181852862408514006660443325888569867054315470696574745855033232334210730154594051655379068662733379958511562578432298827372319898757141595781119635833005940873068121602876496286744604774649159950549737425626901049037781986835938146574126804925648798556145372347867330390468838343634655379498641927056387293174872332083760112302991136793862708943879936201629515413371424892830722012690147546684765357616477379467520049075715552781965362132392640616013635815590742202020318727760527721900556148425551879253034351398442532234157623361064250639049750086562710953591946589751413103482276930624743536325691607815478181152843667957061108615331504452127473924544945423682886061340841486377670096120715124914043027253860764823634143346235189757664521641376796903149501910857598442391986291642193994907236234646844117394032659184044378051333894525742399508296591228508555821572503107125701266830240292952522011872676756220415420516184163484756516999811614101002996078386909291603028840026910414079288621507842451670908700069928212066041837180653556725253256753286129104248776182582976515795984703562226293486003415872298053498965022629174878820273420922224533985626476691490556284250391275771028402799806636582548892648802545661017296702664076559042909945681506526530537182941270336931378517860904070866711496558343434769338578171138645587367812301458768712660348913909562009939361031029161615288138437909904231747336394804575931493140529763475748119356709110137751721008031559024853090669203767192203322909433467685142214477379393751703443661991040337511173547191855046449026365512816228824462575916333039107225383742182140883508657391771509682887478265699599574490661758344137522397096834080053559849175417381883999446974867626551658276584835884531427756879002909517028352971634456212964043523117600665101241200659755851276178583829204197484423608007193045761893234922927965019875187212726750798125547095890455635792122103334669749923563025494780249011419521238281530911407907386025152274299581807247162591668545133312394804947079119153267343028244186041426363954800044800267049624820179289647669758318327131425170296923488962766844032326092752496035799646925650493681836090032380929345958897069536534940603402166544375589004563288225054525564056448246515187547119621844396582533754388569094113031509526179378002974120766514793942590298969594699556576121865619673378623625612521632086286922210327488921865436480229678070576561514463204692790682120738837781423356282360896320806822246801224826117718589638140918390367367222088832151375560037279839400415297002878307667094447456013455641725437090697939612257142989467154357846878861444581231459357198492252847160504922124247014121478057345510500801908699603302763478708108175450119307141223390866393833952942578690507643100638351983438934159613185434754649556978103829309716465143840700707360411237359984345225161050702705623526601276484830840761183013052793205427462865403603674532865105706587488225698157936789766974220575059683440869735020141020672358502007245225632651341055924019027421624843914035998953539459094407046912091409387001264560016237428802109276457931065792295524988727584610126483699989225695968815920560010165525637568" ;;

(** 
pi_sqrt3_over_2_string_2000
*)

let pi_sqrt3_over_2_string_2000 = "2.7206990463513267758911173864632335984260993721391108633548274030821847716895308255261874823180902532843336217215997883561940787410516122246973780471945928074272151105071606069926407320631215050260199436490411738611994573104634564097276251425400592337791384867496792738531503755908688294159392930817350006553434105356116752769892544162138120764758932680400960448160574491309596803480585543534970781437557797530573104924990842174305955365341922005452803161699025970771025521173408012537984272114454694894037585991508686216831576021038048514103191563504020401188548314412282035224115988825835545717429691325531600376513919561019710037879836953583879901983392966634781510062500750756944690533333707348100039222314716346524885715551854825024485691037579685679693038369707885725177104783247588661153444463427387859212832429279247448410169983512035228487431086946359808564858159787685162879186164433753334576814659887581309409558887064246861421259503383020983023174436454225936586618158636979284521950970630746419121908923081201542756378309298996229447185580881264591539469858458740661651509142538794755404627240173080387592375699778205320713962567715219470572493857701378055651612330089104621562535503293796318749220344258295905168829438348497792425069965232798395101160887116725143361470643578026381152996572241488892468259982047719368012173188900662946509655974598048346528979686976958888804076209361166540704371609471365658085340968039713604386497802875757765485851456902692930178553526336770293386901221522831898204546414170768297808208403723684204215427401316902549740082060396161935441001000042327260835241627100691542183693970238796767421706031793419565345410469549027373119213813026406577379804785073767429451804666337697136947502388991025107668294693700271592474273898844052457144153342167385800911617768074294556500450374678259995000280226355161352143259600644716783216865021466013908629559836007620301423861196436445664580994458272741704107342793660030280520213415008028445591430514626020556462" ;;

(** 
pi_sqrt3_over_6_string_5000
*)

let pi_sqrt3_over_6_string_5000 = "0.90689968211710892529703912882107786614203312404637028778494246769406159056317694184206249410603008442811120724053326278539802624701720407489912601573153093580907170350238686899754691068770716834200664788301372462039981910348781880324254171418001974459304616224989309128438345853028960980531309769391166688511447017853722509232975147207127069215863108934669868160535248304365322678268618478449902604791859325101910349749969473914353184551139740018176010538996753235903418403911360041793280907048182316313458619971695620722771920070126828380343971878346734670628494381374273450747053296086118485724765637751772001255046398536732366792932789845279599673277976555449271700208335835856482301777779024493666797407715721155082952385172849416748285636791932285598976794565692952417257015944158628870511481544757959530709441430930824828033899945040117428291436956487866028549527199292283876263953881445844448589382199625271031365196290214156204737531677943403276743914788180753121955393862123264281739836568769154730406363076937338475854594364329987431490618602937548638464899528195802205505030475129315851348757467243601291974585665927351069046541892384064901908312859004593518838707766963682071875118344312654395830734480860986350562764794494992641416899884109327983670536290389083811204902145260087937176655240804962974894199940159064560040577296335543155032186581993494488429932289923196296013587364537221802347905364904552193617803226799045347954992676252525884952838189675643100595178421122567644623004071742772994015154713902560992694028012412280680718091337723008499133606867987206451470003333474424202784138757002305140612313234129322558072353439311398551151368231830091243730712710088021924599349283579224764839348887792323789825007963303417025560982312334238641580912996146841523813844473891286003038725893580981855001501248927533316667600754517204507144198668815722610722883404886713028765199453358734338079537321454818881936648194242472347024475978866767601734044716693428151971435048753401854871978498171578797862574705055586118480974544127839248838014963419252344251830539387345286023806694607504484080699475624505200207655323792600572889555014667273281155797489419762824871884385791643672348212893972728665478979118115392675063032572810519042832281433674735643323719280793738316082322206416519190295943581796522481636008924890101073666519661501290429787243208904403012876626194449044016157378609712734956779582031482137001916370540383857568261585661103574743525068448269778512883738443557674524034077728878998702772569096453262689728629595424298723115594455484988359010996281935717965626127656826745836674377041052621490122494450710658034350390431689408929848679398272748137079245045045352548317805547044624078231091684741214551839785876185742803899708541173837262223533010862959657624385190705542791062996139957266756355730572410532673631201130374518368873305443371849574899901355948479321460897476868132910430034376703324787393202743638664455860101309881764610136862267602037066772046106877964951317277861046920902714653888182807814211213671222758284028943874586162736956875149461136669984139029006187320003023603149621185767235947463797853592787185161453556788800249111109656608976028424163662393594652233107578878380185674326918648747303549997207146531236431569535514976826794247564611217912173100469724161417810355646977690411235395124173047735617068484130728553131996986496032025652271018367018304070329314662192787524250815852548957073875543590846436778174981977871990477635089689845408160906027428588816122021189171750762664766966248165008305097122278220744089713381058759034675750002441516101207527950026880912289356909667956760984198265010450061816712805215933533403503064411352281629175957132823423118163582966751223518682190426023391469836041317483992586163095745244902060262616676518788160617561276810288662404852029213590791859971956608582285614197257237879064017826369197652915393301883781294192630721563157800432396160460581288794934892643018107634786319789508201469398876369446495040257822648044684428828823858111165183209987470961598253969205023701557453003267966995272063889368816075123662092981757722714868536171903801585121645471566102595699431873637886388075821329235378499067725385652153956681815060912640455178789386570759994447393989304270939277910530904936223570528841084571875793004902564358037853197231847877219137872737686044355208905974233521071758132943419441361661663712116370387547622103164339601887104133091142788987634285896311863484505113811056267796267398961137929634371383758288012470538401837922115034863779118548544172814751594556642469518173170686208163621752594966990780958005390460080252530314021376527471457740983685683475225373972279766587932996788971006143471503590204712318787919809849211378056472569967209648491698544346609469779020329096977538214167731836506277664471251247141518596158833853805286990113176619956161666106388384993161422475470958917955383964028680736703122374121895175286549688306643381126803222735828420690127416301092516148748" ;;

(** 
ramanujan_string_5000
*)

let ramanujan_string_5000 = "262537412640768743.99999999999925007259719818568887935385633733699086270753741037821064791011860731295118134618606450419308388794975386404490572871447719681485232243203911647829148864228272013117831706501045222687801444841770346969463355707681723887681000923706539519386506362757657888558223948114276912100830886651107284710623465811298183012459132836100064982665923651726178830863710786452195528154274665109611001472502097904639381778712575009803657792230643121651131087380599298242335584945612399567699978435964864096003266482443521306491599303270530753256568618388265483309802846696242873884751844436838530734115044469478840059464469131682120592946054542163754891890060150356872862933140063632268146351612163764864131429342351600214180513528287731960179813917884407150662994919093496277396207234135302557578180281180210206340974993923837290330361739816633600322612620886664117180538328558970002735722645233287010649586367726698687384859165698266261741988551156844303327351231032433075727331649536152620482684798306053981003157759802511144595774183596489094220203477196778483082245007019118206108478776225735878584402319091953216420763414005680399431546526673794350216992134747713261128519133178491606658068403489787814431322679410839519360265028960726537291276226938242717551278279653750700784001190019241713358327134701518756952318950577522896149682821650782166855605218622283761511045290704651981350624064015699555055607723527235898359267993820905324184058912744801439474570950647586555194756066347107978366612927647920909687903131865554282732062606593248413261523705890098275370715373630772580812755826920872591581902005039751192726281420515295848284628604840714806749933756897548169897911661250320738399632947197475066080743912282251610298715312153928673289056455168511094510850241868813357753938319988751316257344799941108118740096770682577450950592795177900534229227625135157671393352553508698193649538153388239870759679764768250913442427211537562946093572780028074511889735844312259940735856399371784829990194551974532163306918949854284971083760360060882811423589700107764387757873387895069279740596185100301763310557337861867892387235045487036203755348780416373664357618035132842570422770827957935595617406177230755350972718654917958332604207054126315186154934907788272898930465880248815510683624510626921965599410089623282223201861259679057699815316777233423677409136879126707854812706366282542400299555078593139283317852795801122138208540626527311297327812569875620203969803098714139811731222720658190849704775251835681209170969146445624955387671669403414099795804810541659891573366700726954760322208478279545053808382248022276966698762225934691455271794870404654995534850029577320999166632310687258205943757826656306450926187266731134282850930664057987587279621350701915108243113766151619613303433577226881507803396165656366761885644952793565100313654135126806007698563858138966520898346555664413692764517828477073091414502805379866083023808558213356755232582781087015247810451873192017612510616738555684503030887790987493937682648835552467979695762145042328170458986414118969172599659554582470244248012032228675745286155405867786899721646503149603485506447532490935415570400090933768786204305419069553940090486973246650563385599262680025455489867365810079386960274452885844538310310838524903876155416010809086107196383777229486764906674701011145295823272643319533500795592894332408159960312502951148395723104816294522631069485470507574733357909879911719682443743948718097953225973959798725162600884386101198329736651529973141342684829331917247177844335584392636063684404271814415440035229421086115343852839844960540706006678439509873185318018275722875124115336847281899249489574215193378777934122388976985183304869351039511135996269364037721096690604931123281354823742424337501540693110440999189325248996608855252552910694986815657737604478583344793522845362075573186303738873669597838315698173263114039982555987639503658048499492404507592084916152955639877008625738259248351710147536339277455821061709479370587915374291402706966550838020967585274433349444269682315549707191020006410299181611155308064009740723365061646456583655980273788417662871276805923319856900477910506160072758924318683369032212991853186214948020144853310859991333784329031033515969658310350332454398018972683678234782668033938897429130837544337521929284998976561044969086998423702613998930277433588754806069643991992400342972038733342340781801713217482612817656777233021753533732939963865802153848718850029695523698059433109428706700471639087693950930350161182116182933724549741077554939786435797066724118420137336384149352763288680644178217635107609543420365149011117702670466356770219027803469831087894276901891814616354931658160620793422437926069200225104204571854364887026053444743483045005213489850599887175848676747110519897128760536437134112780239674282892653447202371597713128141972753099162509623110444051519185354453300281269651531953363909597454255939325862113115294044509876010925834921457896136849807" ;;

(** 
sqrt_sqrt_2_string_20000
*)

let sqrt_sqrt_2_string_20000 = "1.1892071150027210667174999705604759152929720924638174130190022247194666682269171598707813445381376737160373947747692131860637263617898477567853608625380177750701515114035570922731623428688899241754460719087105038499725591050098371044920154845735674580904839940930900034977959080384896588430050411987170093790798209846252353739812817408181137808285520148422100609589324124459310350575191963029413832634742802798244080228008217292720586153666393704002382073085456530674477148598887334576271867838116547045872761271112699886784349301758614249701700541314551438919987437667621785161783177987307048236318734734842180537156986842636482761056228477995862896332939281687874758656034737919964594007561544437157418903039869712943062486253517341291535975311215446746159086477606517445957055930979119465756398917686972170262497475333629918606531157083493680769804948170607437684746785586528255014184649792489099515633782998595087643532396621477896547910454186934661861396145218563917026341604354229856108549326870868151717454045545485315445266365049440197103376179534564247665528162951726493668794795103651810774498212513876166134014819968674739407760028855337184975468548150192297167211731132486081102101212588939037514478889744791331529159414395971379484218025872540181563578955229618712500537982599156122046918546054203769953117332855096560363721199406232272604402000314922143214985729797309216961229956894919646712822010257214109160409901168420400365699528737695545602799844573473406327785824497733618331088669512833451521516512921024113577318717078664484896414189434789374805476956128739575859748450703629203132825255297223387618655295760035539207961817872455763246882099836717799808941749168611915404693019126587060246857751337673373820854816900129254546824528943214448770212949285515116323776677355940265923008798064734397373852723244692826108136775534771912438573641024245256095269219526299350159735238478305424069606586824014656745345112459128888699168435776764256040911499010917048563417167420507433528383707989434164318725884739130529850712603481195954647855222850932577355903465000269164936329491150864774644459077418095868473311198122989269564183230349586377140301736666077837686866075827148360779798127817013448375291822737480958496977561043610695977256616049514458221213527859270297608124363941459394041101242924024349029912791828095545743219882474626274549265643823023215578534648431605080864723750249801592029855566655958908654984763015387239274841680370581281333339705372100682139157545956123529166182485595700395893093420019844118075464024153350647249382476933006518487532827032961955084281563705723977705577921413509038591467353711216115279620347293639532226607004681869405648218923394638532656420330998981236628948646108717449896251153657062488050196078508126887554535216946721249586601769276446907559083505115632527985192933208795535416004889789879375113096532005138617546601952556003077309066924886645582194400472803594156912394734726977684423956578038139230712067584660438303333392959632473537384507038961402633691286689909487110757546132154147185809462210905319068230603308861076649341416019858965086857009168177347889614121625440158044081354249446004298101477568864146591933357286327188590966242844411977129230388799932396711358512609400882024121916616724610515814317667818515615351604097586757525690424387988158812694790507735194013855432596462528072485393274962832837847551538824194870662738507768359459708179608912108284820777351065349964416938518464320125469593015455316845513202837892695179008207000493292008572898279650486600923646374954168571922560670663944390216359206349025623685957462582397275392894402990630877350506837095936347117436592311659210671527213007113884995529814139282457287508728657085887024953819309193874886871640824589921156196640353580629813064765213191983514034903185653156258189148607859831372945184526978102429749510799115578274404294904201951619584138393893992217321737545834441888783730498456587871521684419035654997183118718674853083712738692258887250071873384846455692251125504076431524302252986679424877010000296131154908241005737446121735092036055594920179134962776873446438052203910773488710201865294040511618882603395073206332738425974414352904344894403507753987316502546875515945705526751392534794770173112735788949386684980073901898464799509877999097064035948758736478363112435009900314393086220079751131212893780039120610083017408156973235029960772668928003432957882888668934295292762884344946665008451210328148112313543013664865230614999499301587412050172081442925948610665288134165731968257911244115641997012060839814232045258535244684350825310791565029066776506490697001251343167124042277271246963166249067458766181197378402612691178138120796440786559308906002827030723531535734559244388764705491246167883286761664485192653964138618350936569014497262629517572633463162384027865199435455510837269439451956787903848985417629671585426630133395024181559644470696019855473672018697391987899538907075636691137269472741238535902671155089123060402865282228583565685794855952741252754316779333938770068819142812863535598308329742164335809936894710485938112970686953766682521100705616886889887924681288210486181858213515251113607210984092227530682071698291579976150677992913736152266756925607226140458321600304157616549591997258284413220675994900000760229715786476435247445889637462875561914365537547582325297043954840822169992351528711442721834322690132215086741293167675348456532934294790533604864234236460431221411775232083777417300397762932320233073318213659883949318802681502678767521746075933545784633126735512557655758249310113928562352194247993565224701048766407902340440591766398250333228353416507047644206713824509487339699486400824433639137572303176082721731894008254778350965951945983694446476980419332812263462820207539289397339071479475462166519160723265934710240686676604613883053377381192181776181191339930722251810233840830895678838113610807616267854579864252119489177183279658031339797474059861142948947538684201556337019835138104285734975548398296710003160888945435573976937889494069839643812372543123557122811593860254759414208839138178798804502405288601311944343572803459586999835886236035826657153961857967578992206052895128777694728641974669751570521909075099972412201274719376994681933117930336414606441304861930788106671610218084317475160866246224055692852866530164167118926052538177763099306637179465455898914248466677245678011913211674817181208679453017330822190974800313626333575076810032420553008560951653977433483421461598452606415884813155591477711413293491205770458919320923507437090168324074273957767996225665792327106996206262320809135938839016327857493358114256945511944307071108107215216985683075920630296713890557037242979167414937760828346941137589384671088071313263462970645725190012279758297639036506370890988315448046985455608198164166777102337253305278073174491839402804808660822964355786854842604322792395373158444909530735404939458850431760980845732586387635292991413246575851435211334520279538993432832823675727178314390503142250472943206096993061789427938531804885088976079671274768697099711053271832229124285384717371486376408625324901198105402438047069661968704584930039792476252619102710426052156333567722952218689079435679795417536486743206067219970006605156283618439628752317786530619784793094916396493152215749052044199199548353842438940949408852996349985489475075062286488080146700400126453736589736249844523977606302396820667305296561954368894342653200754654922345962889283593487083170516501417054713525169730360668926447528802773332642829840841397874622448744253890223039395595654097129173573802783726488812507465444049851907200174378245111886807674345193669675467434215634880113179103859443128802280625260342482817856917366342730485530670305892457462950161480261408990645211190641906607362661141461609244879303327184301050659018983245228783171383429144944759206554593448839097377800525626009374417702916271817276669435013670895184103740920009723954243006648287537650687919301623967676402419362976483339736639039984058012090231436179627256772200788340782787982489313387267864187573073004984546664474783994357764211575278134489027221937308983720850437360053182028947135672408536602613385605853353396227877139209740670581084477094886516969973524847162456916831087518646013516047914266745916281148867293935940062920526357048866734784087287289018277672970038107997669359949865405265675976230814918923432984296769536571396055529412781658628481204659552798454040937948593095138199470546107276514356910421487463631990256912543619830278220931692200730546082690187785358135799841686358410606174655193530215600674212809923781613457318079180411472801862740701202332423393180612898014665842608733282956212064346187253821476888549944532715734008259091321154388931240867701571917509293826741219698334835900613911031109821706960655525971027655310982155651376825306273561894281587848674199661729412096409055436875920455290077908219933154316006913345967350711526104001955980830335598215856654941447045343427897315989044730950662250960088082510416399453685832115897387411421112130230810156910851447171199052199191831846575987913335175757296877530634279268831649367686608493450943737974065154368605700908353353873473174939668549979227004543091534442248056903398300607324956145257381178315738492953040618277610062559481560839401439208041446596440409190249436732700848713942768045621882921530094791386630651395129701996968639508889763104472408051046983980420239799919584268119274757805011523713106044904898251743473663663457296172052822314666193222156758280448473869313344553149051396252892709682869538264903255426009055732470625329850279486980451132640048940942216307781102479774502411900389174645410186223240839042544382507457857353795660191955069794485373579880760051565672821146463804895551462384021874419440816091415967885835888182999713720030772473146452747774500603164801579848754707632723383204249498123009231051678830169113751550422134917813030079907803053413519314585680869689800082345547356888041717861868120054900711447215259765234994111737697608756244705148772221475570005344592356379791555936923532007026318227300537411403751322436061586708646661874313658030184278218358014044072002968904867221558909468145760092182954451776415603477648466876930581671217630331762687245694588689387439992334440639483964505655318141014580120339912346996382895589851598301239388032037435755636925621927435612415757191049742933031266435300376719055066900951302875471504007122373584491561787282383328307169320175671152574137863167789205180767298649684403555996150232043439306365283217877518519443208761596474010744847684868199829342492358738817986941560753192593859015515029369854422436507277116589961993895169663034426540988644754124374560616833907052877693444746235004089393141992803724949830047915036650572092515037866014802666753177427041043016767114767632963134421156924071944999825912520247947142845089070494566556725672241632055195666134133258497452060971443125769798569034869470756012644034157870153025829510052088368636349319630477412266178801136340649638457391724738823560547562289546677380819459311726838913713722425986452914917191558165698181842687920342009958186330958642556430557728120097808040284134091387292493753890809886403394737118084792245737666075256738603664837354041834939068230939862230306459851669366628201010005298795188579737954873658756878608724740376569463782640291966735552409706415143678756936011418832314318417352791629174070963679997831905697646683479056730803230713523427348830096442817311351441585290720122196336698378077343745021463648794068812665936759528286014314060532046893549945981145923139970802136789284323060102000820378904358916409345429750804151210211609872221874424183859963413334131829118035740773443588810569508050179014233923764691934281356813503690093291504958887339770871514114435003454385605765219191495100764169379798833178658299240204360388379858435825171561034457351137378089281492521487429518315798023315431425273044221371561704162458928814914636086152161543504059545960502172712249311308676462656498246099157600502561464180359655752909817526200398765239965676192941537604253029093942780603650725981223984507908552077814449805810406774695234255154913912531089293050701410113527970355196308242219480833517459089606384328573284630638397597944469068716905570841440754394604381750179727354020886015774069838692557501529297843252048463096920666865021588833783466944737730057269465683323262251567567802291299832718334799819346071682944386450635264367727038887359210839385376550512676971605538168809804423413888465610838190535865430511039848817973274444412553992354117206554015514883105576487509803405594953799037114407487100672355097811335479322860363030237754568454164101940595927250455553624871201845442193917293460851080760212658688219650910627832515596605504147527281069632958312501810392748202642490360960369369410389692112143322015861035646795598857664548726869059607080662124365705759871129594035191422421657600826974242552156932670374777705378297837433400316490378267719226622177183448113443976476141121601250999312873831056052542283480356717402801198707183557176209532754672454531163955916689107229684269212467324971409471857838813817431630088060457904768762688505236838743584900552087305381403394912669933900350593847151451803717795544642918290680975504576830923816953876168666991026703865226037539619687655870319108078621338091885471134892874837130555708597154614661039548367629161022335343062984859328474127839717635343351452799525206073550788274388716530212655855625801111013060290645839840695268163753982571491509996241744641197449420900790672369931026371517815354304033884821682519604312065586570303995552088655776705988252771223050082252853934349652172410469261580510540689087866464600950499298370473419776477407799445610640747511667222207602820764121878112002953079285804548097991081420804453858134230948319399338533107737666062255181810431074476867078335883435774232937623510064662126046265539737389026623404167759060444566941807002692588544439263147091888773867738772546789357398147474907443961730404040202520015236482607837236195832298716797320844610368008623774155353624637123647472050244245347188867564302719688595560617915014299943912719728172739627189513509881598038330345294367226457455107276161637759413365571771711616457371187276409958132918850995958613880066824122233413085573732640497819062035324271243869882072940323577808073218156241209987006727436351312531229802036645852462897727987715964309839833264453396662219528386413838096860707550058412375214870396385508353455270099375966156768991067681800401197589822151289838730493864182752967845965689610614112223567458625078138843083717329308787538683232924934826328884614097177615079181467117115476897273074486730669659218911692600644293343418217742612029440343948307930222497969742588593425301762375937930930962008057048831110519540194823874408304491402749717128214524369657310025385103298577048847929019435356828769514493680305216134996336430312555347865648338426196297929233958726513982371441483700224835775159237166325154996061237201000880207358088274673694904073569544149133375263000172835493708495865686156824293722914040275341041849441157281926945240408731200417019114881032106017400597876271599731739545339036498699611535735795263247038343827934787318309725097708431186741049988293820103485001893322313896429010100972132169698318723065690534193429305781145239973367646755578561026482309586946183937727757625368400905953135300119382567432979484369520995742747768178343239113347044974001243249185055661168014458323774897654292807371824895143619247570847250873183128285429293165766859886258767381331109384702079667590166132168455825697652100187636263456196346988983706428301601956935339390001904475724439766039541666169168822220146094612373353500582100139218969832510746707125532685260609117387591796359407521701698699524673845232012090225754477643352677071156461916902722850097900464340861401476947524441111817204785859214979787018550825029826786495664228462240463332700449215260084933477829127433616066256723562287867259423380947229701568588473737694604587853593952212886772583688944890111013759635668535590675481581116123017785215822976797318061906413537522811362303409099678178237956898192504011133235072025978701592175212943013295756828230357221144976225818602182127148921795713758534191190388020983579830296912559240686728838259716132243684450543924983418819309819977208003755756862741281607847430129878925694486816242225817364291707169882248144044229021666836555851279612368756969454949729090295419262084926858089512326891300236480998713679837306448592407852165976125517781566328500884889984690891037674342484773776177851659583067257846884429936492165538871277058726389953840021797470865633492093975819577297749987473105442457938390515847546383895283953086364275005956420199030951325169745093739462537959946721471202940141992549564474492263292937770846726758726276258321417955869889489129808516670770910728107772484723072456199250290130636541681575350880908829669555922091542762538200016433938987857730726293229682122568113906948267062002147035046347443527968147470996327381625294999671515343695819391059302499915521010566656716258946355162712791591768709216740623765039351521955926032429933254320114422973639879200743190041813181412540710524052169922646823206737664193858301306920804407131236894459708057895581383748532688518957306177127663437989652061543375024588556754022655670052048695318885156981303270109528423311272018553461751567900002237090171749689034086680110710607068279682496659269206521586465266960354655802678595227367573446911520787968081762237666206184430408087131527597517277055969794627474760542112732585559863626327357358150874227183627707881651546831842969819303178274986919985504712932202417419120239936309491357977823317734152128844705175611934160367160683380506878964972628170641673487328535235629828946789023150411147178913643891534087910430730830666627116525346046749308992917567178735028905420900132243187479441667323120170795923813834920711100511304210246184507559673746855442280463871768964472874666010107339266365558870230703099613506912844184844202692756082385369182200854953992314688245441474613701996217546232747223380712607002859512864435001939082724479647860822757843754435042662157446598485568255457063443642903955416077916227921601701397930232757392239818420306459725304105135072974495833159835838849810728030039050731702389142821351521711562531855348472319927630585164604228892653846922029728601534158165935298919548549945009366429524485086523437389001127278095563705904343722567308058253900532227272489618189403574049167876519994807661962753727321589657585082053612978952626835561355898285452582243255540080454629771926265414616937417133371044243792950926915747358017932316094367793549524780766981914688852642598905240460213735432611230972515961346897209626909943320763464868316714042035080177689378702618743733824693753573626464917697875165172582678598732853654653235674035724337920059542677068166580801305671078201020295646817097106670188802593168090223782402153087955470189180385456488228982399440713796005160891198694644734064185040419149636906238574131188275661912229678819173386293435233554592219196783440557750543093703509141655261211478711007843992306257212510246929474309808233581849863686593759450805759350167463128539294135722927719675112500105048606922557142512214928624308971188134431606694540551359121655107039624912049036922610203923296221400991025464077382479963946425818777280216728379316361312359156807266172016346392060759334022225048995012924293880316278099585183021916120840992463472856434470933957905564051899608740554321819245580321419306871465020834588047958643873388310125347428895705262274946417686369041465402152629328411645236583501811914758133968140066960066247707121872748590742816819636582392077995656110721731279721400031128419925367245855765073527863851741356935316938370457441207936961771112020541811453995088817710576350270419561606457443932635559768064705050854392901382288483044906358936363123593283817629543" ;;

(** 
sqrt_10_string_20000
*)

let sqrt_10_string_20000 = "3.1622776601683793319988935444327185337195551393252168268575048527925944386392382213442481083793002951873472841528400551485488560304538800146905195967001539033449216571792599406591501534741133394841240853169295770904715764610443692578790620378086099418283717115484063285529991185968245642033269616046913143361289497918902665295436126761787813500613881862785804636831349524780311437693346719738195131856784032312417954022183080458728446146002535775797028286440290244079778960345439891633492226526120677926516760310484366977937569261557205003698949094694218500073583488446438827311092891090423480542356534039072740197865437259396417260013069900009557844631096267906944183361301813028945417033158077316263863951937937046547652206320636865871978220493124260534541116093569798281324522970007988835237595853285792513629646865114976752171234595592380393756251253698551949553250999470388439903364661654706472349997961323434030218570521878366763457895107329828751579452157716521396263244383990184845609357626020316768042407958946934247814145806514304533258897144676931113759240470507701854604392721283589419214379843263432294100698417738335607269111071255492745618417077586544420760256783418203741482945546153472099341059170235622611591140473275429162701127030178169587324472410986149295950880807517852655606283168352976895798900215785929124420891131680348115611623208391583288567033862533128756421231384677911610704822960033016725833901232376665967366530971386085915657236173634055705171823291890520425769728252651079969503911422622020888378071237482189501530174909563664670768257847809184484571051880968132858766824070817266599123557249784105313089662456441259022156752484885996542258742614520768470073032481574832497802205147376571890946983085120553034542635809294471351965188266960994550791194315158059368377069802910695889841247401667026290488552683786810335082813246509636489621888453703703404572644458517129229582613988281792146982148047964440134743989116494380286077064254662124152926900700655750511024892890319678650629790711699838075502809383201972706549004116860712028544543713153573471706195989892377470411613796532856261350728324978634165339893231382896142781350026963741704885055698136254023601712338889736993453417252851918847523440684549499653976577654827025830162852577896168933698818686944357929769878089630813653458268274034338286309510917388043454148802154251615238133083766123102355823378865206574300217483986924998671647488139187453493839581655762136105835492230109518801338213521982355188168102002563135928934518433995414707444435640240824926303167331677813927583930422631284166295403401823735562935667558687139378733830325352549644102733713166286647067341449201334044027950550200564583262288921760938868973015777262862769067669685562709089819044514322384687617998039835957995589413022136990531258089638618963783275657760282876122699093675741125214235002086286979194984999028230254841794598306309870166496428501488619606021103693662445488021726224401316309469200378296404435749353544986028723689309404651944584143835210369825824230375640744060556776907603013457024357390711988184384582891032581854098404636002693966379531573313702049214469526195795159530451162095613057386514554217115494070434764719175036994252758146821713860071071019053959632467569437525279959421335674349506984723098822435867496570149126380970202893851137155455650147587297071984611242429349104744922298696875890113433424496718184442948961610301500734666617726656831755496122056729867792577201776042355586628067382573479816228970584884695132893836747183662752383186072814717067927834896569769084499681746675898623182035024811077518111957278949425075798082554132146617097095861162311529955652279704867501994718701143453006835075665656507994808827852627718585775142095866903375449796398789974096601096570969556048532764103487014140735166799898604324815688117357067841955574149609289786160444611787615703842603556488751804212641530995166941143035287820977140224568727885062614565948576083632559770643498631179543941707388398425570028038456382184287167185277201856647178709617944421238732386600927450284914133424988916038393171278242428523078702700085426269988615524175499986291212424096271396263355493751932900154227106830272677092171223548087212220849848700659311820874553923833452836667614459859477475710662433972410598113250431305144378175302363786517986162223807998691966860336433813882016859706085440580616176249710614417011288533885394148228587464755430590571178449009530964767458103073668472496742793132755233264429502895578242612152438497954028915205949856729193816532865794752787630778538817448968167953648869502660120810326348492317764287846222822607273339266346420610109112630185409532296436625554907896713209593379794992246220761222594789633024531811816560886571279345057131118810171986629230925656076408790689789324016569486995028609933326950731033288943258787131578760430577524045663374346119538225184056622000671966365812284768937269737945832040361638837151179841202007228371735390183056569597891655162695319476117106559982645655368059260668317942755095070405562222174330533188148426263612187556595773544932551412188141381803616628158930044594547172790756359963295137696372431454720982590734095634193192281066896511266668253158934787469325033452012461876817004546936354118636018872262703236773588992845283512828861056610324942776290419134697267899331691296962149280901996249121152733420860012335807853026713510771117499489960766726197272468569811908442988415926630525920657070561687704641199471583304920525745966534577588849446695727542217671881082830242004744177866191232075966945229654019191598456772782411059413811336224600004345125322560925213607557115347891655937482983951515375918707617884898843836918929828178620206170560451259875903365288330579778339802477438332637665005938775233973702451408405718897300399349777374324687227067925893385518428517213604877710204455781875965158912015064265764155324241848754051070313974967969272548792051703758044208479489497014320827560849764875144793451265969781642975118401130976104806443328331359113752195100696095616928132571489670758396590549155795065445152406837684649476595760739387303378023172970315389409707931078394951466215517355438874800782528262468475865846535279167857307610668415527388403895741582889241368180040585748551541792870294733554869610549492500535252239898914553591669129478767427092035765892173369710753549071461242922186077851095190503265915533235481221273144975357371948518461729976781847870658566153627902600325314626480115333571128794767804323442500404786953951834000982138619015094193086083871046569340514831329764569874372963758325171630872118051165499374360170965360135297164954243579401118007794280587853908249654632928022079353016756240495594418835539305208877388616572637212715071736314564205460657457442676449510201149479957632548147135739093491288675917199127947320512385404472280940132689197607895604633036072650071450101317782430680385937280483246100431906026310198144768694903542521349183451411755877436121115807781112165605256253364840660076283434965379830703310884109386735842900120599600746566612253153612553680531410538240403770101306620487229517481945322813150047700743579184938644048494314424240275028808803972281582850622623039937471380365006825866157892558647332319016035824768082767226233173560945469464949489902492639096292420293164166522020669003223780936874704026383925099234663262755650359898417512606324414211333925866777957836701556847706300208337390915249066034240004666128875158398033755358400853059457052323994589376323491075837566315155057373141648037410193747504937056607270236707424983857360626896785748220848415218418429180808494312081760361938807044518000419577888329298515537846527942917190836116554109816573414974764861388850040389074565019909810050649388020274049947587071173016919168594643370665634221605382706856054749403187748420963814875841598349448614292144857705833045909297956941203735657211528998161817370595917148467765181963267832433769289397419922058527605703658668661638549414913476791284358162404712140798765759916706451869858507561798519540669053738306741469024189293264660009843087284152465031906127812661065162751564774897511205409794419197171181748417856915408996230606242668598842528063234575146011878928258039041890344278478299243190995098866496889319407724583554991402604617753765887842996748767722304609551018549587338746526108420558700513501053395873447478198678981191460311104366463484853138306003158930000112740479392080224777376111131656286995059207125876848992998457155493900511534752342837339825882029298789598058333987204136667133330086749789299670927529655848213265023935481779443305628858622542063487783755474872982327566857569853984604277366554664373466837740767393607122029944879816779418238833682533923064920942768815566700184582511503896988757100706248492481019539014413014593941835413864744694853616092241097129178221640568247507225679849077058944203311039280265920329381707270926311080422685234448986994493447200401467121395518800992754418712117221059212281081660981885175314104970747784494919635874008436934206437790290935765539335995638249805488261583379689881611921418879664727082725135519683544857011632342958787031255221966823492566330815378007111471776434442649075832524903400020805478135573001942041248220762034603225817812526160223403518647582634932724960833203122938969314231591807722739542992866813258932084939977116458734762128198083203764333809643373969718039177084892760367285564026668342808541167446857866227995635467077411575582172378727780499585117667658538841823656523056086199290525763821001200512603552487761390767004806552496857642574852047902632760323507350329435741553077059854298489247823674580485030558642328154938830439073393179087976502947990858629846439849990327253625597212736243169665623998722202354070655212070879540104771948558593646388380952296613542533840297237077076801926129602209686693670870270858045751286240930154483146568632794797032978698989710434887770184317748184441654423551017597045443512208466482341626848628350095089618617824483944205015750925945310561781542071912305353320712629720033725249091595022484943187156574045913239460642939973120754308109111823124017553341649925563569111529028835033892119229299780545557100920268134738577615646735772324482846359391935504262673260758520102028912171169846297119700328901657693532981728732095992104401316220592090108367387796691245059574510519146647965097654853834046831225488058571800182205475126266796557236204517361372630595454542111905873372732572866240164327187444106886323829192067639737683329995921069631617659550802906631987807502712949259304232269546962258872868198868806442881713170828727104669864224897112842889265473766771097310219456864750367305861833008397203408758667347628942128752716820774186308744555809438689898281666254141733564558866154856313495889465767484807450180014138356065558791028343037480241025927437319938148351620057720572494471034455278050361405335033967007204414783501121916882208144425891279268432777990461611767731921440239394466076186319889261170663937232315999102672496378272418136448539036771843138121136186565370612529021880492571901606386793182799612331670321927725603868445048583721780261863909458003244951425551701977672235502342014621586409264204109455880746301883557452119468699138922594248640571369488680561307288806987908760111957556873241119182292478530585918244922594500983630568544334968213191147288636090617000338253912973273425520355284232721499636138735936131116443570359914532521198753543781764826569078623413088092881709562469699128847455465832763639321661044209895635349846272227751495695335709043069558533566932982143772777314214682072289577601710684774940109693752648324540285238148934134981637138671985595434531382570261061765575518776829999103554468199889235095059530531608840427012574913772494506077459597657676105838082534499534965835434488415851357759078443461193783423466643238680510850276699678759888149450303878766002520249545726825722552731932163459057355320683904460090959192895786027181772150882029470848269095271624036296985739608161930143944059805939866540007081074702948755674128872408664518096138567970723871552505732979575694542806307891701137392243261588337603524093328983819145172673810311461119238410280841174959671013400551001555066441501692466581071682787967528565308224760886064543504852714870205230540840949013300231400275665365654805156336584429394098132504660995352782440987245655709893906223186022228769788778867657284764838143465693603975195286986921692897861702402798772867185632600162833947514850502121863878657285606527371440507599298481447124862844494746892680280592671519832173062227896442960702342065148457459061055154790243816381489381265198601738801158581832531849206121000848329341344366874231421200939413144620000313160035502376912061823220862885618731888721507886551421531844480186364070279037257533145608299018091346920087038186475371652691499823876749493084593355377150335438782677517468188804508442026801832579330600708754264937497898891376566507582595560640938996812917303488264591989785310000980791660319749692456086448361297643188038680010555300125188268258512007066344177394909816121053330801362229785891222137897331040485251207582258099129196866706059985551714352372032206643585947245432492804174492366701639435842550596945554152748373312498657387830698761715097046501491120715714736558304260694370738223758016991368212550548329588563775725804942036100119147601246991745251829416961567053862986031499762693858598656600854107388770518032026161770235423104356493342268597301714547155264577461728594037794709415791954732247120268063372128187337090670239772869347510399613675223844963681348180471551687701364785909184261432838591312974580741103498057116678645105883720510296405528371477454967602682637297419438607403034889633103429839919882707091311829880470298806856884015718572268862295269569417995869948083335762922610132273751545311752463364175419511388250855729164756546949166443237842626629615675700093123919305488747524664135712215510052018391142206590722325473545533499053887417528290932024731313842592545623603297854078287144042391321547292817861540929382643734145054518859659227408396244835893199519451565851304492673430144432507066732356265108371156029464093919159340804211135263431034073719983509939805291334690788265406442505608026144753093792513795120943648326843542244086047729021147617292631842396805733187752257614269023567392063124401855348323155472200874081715344368981051960801113221547306786461845049380201280245539275911944100276319064661077495314134741460513539014896759273003563001227967279912124244212864285447518497986462616847781729789778976486647200828640382929597416971015605722887428623793287204243672896346723293016041804071988364195385283716842159059135288708885045506412870845062515139756325549854879236892186726438310889297421684046840915436468121809054700833547994962669595614461391766104178785405549824638229024221711662566037791631936994580075745983194671550304286522148938382275661780479565849436793224111670363582535428615209268849843245851931277126575917784466735946403629865702300205859857477142597890716928131982569572784333880545316947843034248904213682475150684958128245480177224032431697822754669059086033049757062331092685762064005809235093095087712347689641704065760619299270424590909297021696857795280878224733777674151214735177710009619556839622376172153765991395952133066407316110777933940250797707514686193218727780588007280136167761177584720129621252468803573448890341946011961455500947889568883633733800642768554549737114068618970226170009291774354271847605948356936240871908918588160680632745294146515460211373900012688571734554659764841643820147561276028156703169819057216025651230264556950042353946057890589477588572030131388206202784018443490154964700919711053307972537985863713004259614915222014965218078591706761860861607185248569464452476732876238971782344865482603371175354232305058463793822488601597675455747600932524920178509035856291628960288470437461690121536337606064584230450187313188946794885514465421451757557332816127941948369035856322440290859500946093545965761921907802530552070882851334008604743425637100726283569643148347348267620629138920756719599601466301215073574378012105507084445832850025757770578051941762254572407045046102501603633792361854854482372943776548984763891669293160443016327470983374522226129403425521171998506440514095148812663497529076951516169406845832336577544088097428734770522837522026476501708936137154264333181223049522639179291694459587122059318329739376601257739759250291104657837943058123926790744245188164175017385877978898449554545180124620675830740461602371201730459241515764298622215834005504873957835306079460728967297827277784707340007386615283466566280665347374069529498895797257225055863438811365222435414041493745623417107661468940599434945710768583936198196715565835252229228662905066474997286507003166234184023039327485604364711900122022098334005224989126683735190057886858467829687051430258965040436377871171771562872835139170740453937111031623251759678127435861650421347230439471634008168997429920943173861801232747587826284723399158296528661098375466627320718666823589795729253335532614541757849107307962080727029246065926454649358784589689329324159162692748566456418834169977801264347115156510852247217617774000352455027992203999281487029234906819191288360194956151254046528662493279356168443033962934359251245141033511049479573283190711619570726550163202166209292791862830727489951658242534937833761928282484632131415611356780127478033459437784378894829311643333597420835929018039948102838504240428222574045683164309834166759680649912208836004942806659035141676063795009593044326258862034427452661941876821994539945867166280480369893600089070208363487651863516911813501821583114373535699883883300621603423429538728031485073852647349791115912328603651804446791256300585424265939411841196368285204277259508357322785176474277068792675293951964049277489538122656754291371240709872168305029235238896015872778209154620578255763307215685072433594941015681477496653293238857684985204223252578791073948938836398054502157456242008978539801324934886138252859401015744624382005744889862158248043409805485876120895730187947398722021992559884293859999430312558129180751141456588349768653519073904224465702424596084684911506206847900905554298106315319329620991694469699072864616756611462471194068073746114457057875066968557830621921253037007857893880724206531825781641674748900752349483845346374545654883584643306142374433031165365724780668387387913916768100674305963173189484954646879334149516933259754888138381886988979054854706807374600541569915589809930801458016810122845626484038971876185934206875285941239419846072967348187412136882959844271528923691433202727600121948617827358874156868294809317917140115455830841267558950226672249265729602129564865084101477326315082437087127993298586140569982612428100969066614510025219091553273248039301715946409954874373225204553403482359085576162650812291718501486503520606884236283092508806882483578864717315964972109337634334808992159625707827177506158597882624202914968432128806992233749373508279188535541517799280244133008766847122081353137929827131960712490036238420764590557766026964334969977629281100591808694521770653243059971236709582416997044786496777407181061327127784079238866737849193248061722818828806821021449505761110025197269460304957548920468433891526303818971800902077705794668707337600014394864082227902553000536708976304426427891725805353703439775121396088590606003828104829902250736693418336511672850046187161014239722528321500772934288880050824765444463802440069613202355677484824211092022842942847845989657506837275570227535265685787102080938933785181077472826463547204240205953898695759849411722718436981016987586165423472439835538889776249156662945959494968634557532576370500287254181819182384331105854281246165588743141625343036818421192080226264866369165196892138116868059759662099633704976192385504065688426775670663276179674932997699817300920361668303079557287252462442483715199515421788276408594" ;;

(** 
sqrt_2_string_1000
*)

let sqrt_2_string_1000 = "1.41421356237309504880168872420969807856967187537694807317667973799073247846210703885038753432764157273501384623091229702492483605585073721264412149709993583141322266592750559275579995050115278206057147010955997160597027453459686201472851741864088919860955232923048430871432145083976260362799525140798968725339654633180882964062061525835239505474575028775996172983557522033753185701135437460340849884716038689997069900481503054402779031645424782306849293691862158057846311159666871301301561856898723723528850926486124949771542183342042856860601468247207714358548741556570696776537202264854470158588016207584749226572260020855844665214583988939443709265918003113882464681570826301005948587040031864803421948972782906410450726368813137398552561173220402450912277002269411275736272804957381089675040183698683684507257993647290607629969413804756548237289971803268024744206292691248590521810044598421505911202494413417285314781058036033710773091828693147101711116839165817268894197587165821521282295184884720" ;;

(** 
sqrt_2_string_14693
*)

let sqrt_2_string_14693 = "1.4142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727350138462309122970249248360558507372126441214970999358314132226659275055927557999505011527820605714701095599716059702745345968620147285174186408891986095523292304843087143214508397626036279952514079896872533965463318088296406206152583523950547457502877599617298355752203375318570113543746034084988471603868999706990048150305440277903164542478230684929369186215805784631115966687130130156185689872372352885092648612494977154218334204285686060146824720771435854874155657069677653720226485447015858801620758474922657226002085584466521458398893944370926591800311388246468157082630100594858704003186480342194897278290641045072636881313739855256117322040245091227700226941127573627280495738108967504018369868368450725799364729060762996941380475654823728997180326802474420629269124859052181004459842150591120249441341728531478105803603371077309182869314710171111683916581726889419758716582152128229518488472089694633862891562882765952635140542267653239694617511291602408715510135150455381287560052631468017127402653969470240300517495318862925631385188163478001569369176881852378684052287837629389214300655869568685964595155501644724509836896036887323114389415576651040883914292338113206052433629485317049915771756228549741438999188021762430965206564211827316726257539594717255934637238632261482742622208671155839599926521176252698917540988159348640083457085181472231814204070426509056532333398436457865796796519267292399875366617215982578860263363617827495994219403777753681426217738799194551397231274066898329989895386728822856378697749662519966583525776198939322845344735694794962952168891485492538904755828834526096524096542889394538646625744927556381964410316979833061852019379384940057156333720548068540575867999670121372239475821426306585132217408832382947287617393647467837431960001592188807347857617252211867490424977366929207311096369721608933708661156734585334833295254675851644710757848602463600834449114818587655554286455123314219926311332517970608436559704352856410087918500760361009159465670676883605571740076756905096136719401324935605240185999105062108163597726431380605467010293569971042425105781749531057255934984451126922780344913506637568747760283162829605532422426957534529028838768446429173282770888318087025339852338122749990812371892540726475367850304821591801886167108972869229201197599880703818543332536460211082299279293072871780799888099176741774108983060800326311816427988231171543638696617029999341616148786860180455055539869131151860103863753250045581860448040750241195184305674533683613674597374423988553285179308960373898915173195874134428817842125021916951875593444387396189314549999906107587049090260883517636224749757858858368037457931157339802099986622186949922595913276423619410592100328026149874566599688874067956167391859572888642473463585886864496822386006983352642799056283165613913942557649062065186021647263033362975075697870606606856498160092718709292153132368281356988937097416504474590960537472796524477094099241238710614470543986743647338477454819100872886222149589529591187892149179833981083788278153065562315810360648675873036014502273208829351341387227684176678436905294286984908384557445794095986260742499549168028530773989382960362133539875320509199893607513906444495768456993471276364507163279154701597733548638939423257277540038260274785674172580951416307159597849818009443560379390985590168272154034581581521004936662953448827107292396602321638238266612626830502572781169451035379371568823365932297823192986064679789864092085609558142614363631004615594332550474493975933999125419532300932175304476533964706627611661753518754646209676345587386164880198848497479264045065444896910040794211816925796857563784881498986416854994916357614484047021033989215342377037233353115645944389703653166721949049351882905806307401346862641672470110653463493916407146285567980177933814424045269137066609777638784866238003392324370474115331872531906019165996455381157888413808433232105337674618121780142960928324113627525408873729051294073394794330619439569367020794295158782283493219316664111301549594698378977674344435393377099571349884078908508158923660700886581054709497904657229888808924612828160131337010290802909997456478495815456146487155163905024198579061310934587833062002622073724716766854554999049940857108099257599288932366154382719550057816251330381531465779079268685008069844284791524242754410268057563215653220618857512251130639370253629271619682512591920252160587011895967322442392674237344907646467273753479645988191498079317180024238554538860383683108007791824664627541174442500187277795181643834514634612990207633430179685543856316677235183893366670422221109391449302879638128398893117313084300421255501854985065294556377660314612559091046113847682823595924772286290426427361632645854433928772638603431498048963973633297548859256811492968361267258985738332164366634870234773026101061305072986115341299488087744731112295426527516536659117301423606265258690771982170370981046443604772267392829874152593069562063847108274082184906737233058743029709242899481739244078693752844010443990485208788519141935415129006817351703069386970590047425157655248078447362144105016200845444122255956202984725940352801906798068098300396453985685930458625260637797453559927747299064888745451242496076378010863900191058092874764720751109238605950195432281602088796215162338521612875228518025292876183257037172857406763944909825464422184654308806610580201584728406712630254593798906508168571371656685941300533197036596403376674146104956376510308366134893109478026812935573318905519705201845150399690986631525124116111925940552808564989319589834562331983683494880806171562439112866312797848371978953369015277600549805516635019785557110140555297633841275044686046476631832661165182067501204766991098721910444744032689436415959427921994423553718704299559240314091712848158543866005385713583639816309452407557009325168243441682408361979273372825215462246961533217026829950979089034594858878349439616204358422497397187113958927305092197054917176961600445580899427878880369169432894595147226722926124850696173163809410821860045286102696547576304310256027152313969482135519821409716549097319992834925674097490392297126348693414574933198041718076111963902278664075922434167762466236238913110270343304576368141128321326308582239456219598086612939996201234156176318174312420089014983848560480879864608393596492366514296812577314322914568716827621996118278269531574983802624651759054103976181287604216386134502213262727756612441133610775195557749508656360673786650623185640699122801875741785494661253275997697960597760590756489106661015838417202818530432119044657752554277543798726054881736198267581686283295260789932226683602838513512281059318591028641508157056319717315183136250243590414632122392176633982689368253150530059891547029095371932662073411234947433678846902013904978428521634144292145895582878476693946464267812219049785636355263368278051860098699248937786002398769169807656621943898544370805946433362333810587458162354756001365924352426571430834655457680023708146757325254702550747637471635067851599173693793251032682760628645914618204721486370370771926926823623334720379245964691810526139153086280291440965482563873092730426544662929045896063751918711469345361973324789572707031530930901921199199993615765003503984054067425387927527922724733566770607837911384488936261367657060263600315132952095395202854897384486256134924414708607086602676349978793420875836121947116994223848482595914304528107062601508969135303017720062717054402090669514915274597719705947695474095210287872557856880022193717743558110793930883384558648277291008629554566141306721230848740227121058686323388237413884428938155444647105755651468435702946635062893873569868688376480326519528414653517395302736120137420300986739838514321900436028982698293529399414129230580384565022707216815161941011449826301364900877048398488386090653368599054583895203185648041493272142390865164999431659207965953569430723112911629286797517156688905439322035691293324570208067194440497304943981408227829602799424541083166675921424835182723817205041039274288801556223380796147512433514731021284545944899444996000752437519570116683417447490795882099517836768023236517674972301487457742725994760962198432714835298611190272873584905217975908374197486026706053746231530039375212367867752848692195857137554269684827836317861109933680143915905974842858054516130230143979057016108898627779610750673332676048654929251399781390535882276893732204941483940135560356560442140176120605131806891989962606184831853401836237821726637580455247196266174925422852804571442048578342113228008528704205488992341278554812367615377071042544698685219911228354266349997127483660762462418207364666171283947484732804744304033441072004287271275670279567582429262719454580530026664899650795697781786219421720052371653694677041951119127046248360511302890464377511486948878496151188414719100012558838366606772084112351535588112677895715585904125762616010675131535802124273318710006358249545040995794072547989003168265123731190556682915194305370848930786919742829049038603723116099283424317122250994547150192866648787107951995180054633883844315481724635480244518030845273431000621371034625733060012349737443558180965678464641533905146569193245623531405779193698988423647183525375805257713311200797104068315492665402026046806818391437827214769063242469517128636738443139833371176159418699934662623453734523567940124168092291163609563721674528391709909146648507392051516056047378710615470216996074656930979442612146925615934256494019122989514732544715181263258368897282262833295240359700727863364604594707124174729468775705958157349962848099567839255474240448991887071069675242507745201229360810574142653234724064162141033353340551104521261750359028403745459186450472762434207177092979354010214096464502836834180407586081001407216192477179809859681115404464437285689592868319777977869346415984697451339177415379048778808300220583350467465553230285873258351570859964906867287596729503872547570879169554736691708701241333922148466851743706661548819529332272737436041082542596603039869326542235052369108595126300831846755503459758395505840356701558879777364438048182138707003440236180412002114837279422740787378933162708101362649828962927256244580539713414221451109999544582142923783881026483948233951418767468967831862868178827255582573193951815531695164501494357263106045694929670986252043393852078220762219100344692696633425908530581604497802577632544893708006267787317954852985668394869467335696300140293131419025780775816945815272529343422590519791831662164448751781696775276770913043157342564054922938187395110844166830924911159785773327363884141850737936300263921806800194982396664712313171902523703199058771977410007132407519204181221413242532729491860004200841548511547411573059872196212988541663720877522483769485974767293301868390522500148690382610848248198167593107772702648826209072384775290587650403266727584825218516231074544988758827465678094971230876614426414824157903570393312256518933356281836185405746706380618398489466284245736564564213907216305295529359284877555242754559513382771500178401655305485442285011988365575680159346450558994424849627412711869883158047691814156796185321657169645222594594712469319957116419861884797789121142681164383772384836318673186075647785369993038705466322969807567584682123028077261006969174078202479498821095473343011265454421701958523758807853480037372471187611100087719035538815731922513338424947745031188119474559536533660920641929344003507856422343292324929727084724823557671740589500126876360081245211244875643428094659313361856432414855780791931151265097295891605299303077105635245451483457209224551984890588904219806543973353757599824858037546392736537641967480626968382712920014349566748522472414548636036211584723231736998061719936421136314580711988396812957056115881246205885796650562215074820897477641770837870529242028802900440024806868125422075790594243470464489575440238736936047401308603607599174387615635296776058018334930879646627071160805073761071800221552519199379620070916138322728017731332019005978048207960758032499462238538580357347801871380284039812004681237079092457272857654510489717031023705486787933643781578074007677474215280311849815576981656151626115720204540264412993161170773312538461289367637918385370500942063060910325402584768222036768249279473400061775129526307265637853097368642000776666588993284566122465073002209562877272622278080395483403810962805764928974651843631949840261299761890046781909273709647827872435775220668465400024683307460878358765589053056942574990989039220463004714572059053712091314275886537693148040000871791384569099362998784788542177815407350517062532050951447822066725260862041079962227034808180138006610071922681402919768354884243991628098036185977193588922654858728163276905428617466323081362877649900737759932441752147677604693696223321517592645055645256384054670040452158007545437968103843558514794309229635219785228329574545727156479318504188960701280594922959218359493707458039032141043660163765095548944541902633911960741100669497780246954093656281275384963236010625846536670507651770296951303968587023679128754135880644026342382356806076407451761190883337120914157628056522379012735641935345652676296244026602282454261960342283524002050329505319085320149680451356433410343132922358969728310873956943813180943166691339052648914833287988276285256304512063761490004521864271711150897628275286714663611738982858742531721659624764332384003490049629878948700105188449411866043973910749375734952893477073963866593325543858999353799414384066242210226832851166251136834473289661321052675089379483446349303527853213012782115268594298437565174510930399249586646094238684700215355018037800018701111315193787540109149588908076473345500264098056832143811600751461827884490468124814689309743000010901984320866630922513811211159948127963678390812224378191018777994034076527406038234150532717416278674888085754101214286674663103610880018188435401823686532216877504119780765258115384173656218356750130344565959365909746900776563095156366283486399797549375638405296723283563403031591654958861122299599968682701428407239146230016173544083143643804589220554110179535135588527134798493787613379107565599541452891777015758134875768018624292222977666211542249711334173960319676390935051232094761664275347438833388869997991646383675032418632486284187846996096380827512996338173937422095347586163221630520270351703749029856852559581419295499517655258212347310819766330134175081512367752315160732088182956407263476450588757613618936187012890402679226470494967872374025813008347639756446326335496752857495370151271006944644206246175364428949860492052182" ;;

(** 
sqrt_3_string_14930
*)

let sqrt_3_string_14930 = "1.7320508075688772935274463415058723669428052538103806280558069794519330169088000370811461867572485756756261414154067030299699450949989524788116555120943736485280932319023055820679748201010846749232650153123432669033228866506722546689218379712270471316603678615880190499865373798593894676503475065760507566183481296061009476021871903250831458295239598329977898245082887144638329173472241639845878553976679580638183536661108431737808943783161020883055249016700235207111442886959909563657970871684980728994932964842830207864086039887386975375823173178313959929830078387028770539133695633121037072640192491067682311992883756411414220167427521023729942708310598984594759876642888977961478379583902288548529035760338528080643819723446610596897228728652641538226646984200211954841552784411812865345070351916500166892944154808460712771439997629268346295774383618951101271486387469765459824517885509753790138806649619119622229571105552429237231921977382625616314688420328537166829386496119170497388363954959381457576718533736331259108996554246248347871976052359977691923235702203053028403859154149710724295592067062025095201759631858727663599752836634310801506658537106473285386259222605822205104036802702975047987280794616581004170526819400190957334621759438936702493204226910343698124637201111852610842689102997203112021000635071763745824052038475551972799337976149061078949855442233260040188513036315611448868472815892881632451872650666453848775991625766428721112408420680167635171001029431807155151909616424609070394081292169035174929613640041396704310412536323270309225773279602923765977455370954691157421404242307819923276174019064245124548775168626961053336942162136053946042456541401285330078136334498567364067039773422298119610429255345016014059404795471545345484072717376562623665491666402330060132657440701078368584684523131604677544805004022406399119703622186029202388671507110171694002968687596635000408953162142334252279568340670134701859020283607167621477434934495635958080821304425864694685226109082633530087566126034606721954040559841289129759948100007720574402300476732588000915143714894754448791571912946590835708739615155377976402620683708480460729693827195856897597596261041591526575777907823349805678400229015320521389353737755365664270468268742899634413957436660737444455830864778932129853021481973953414781705166149525517632919936995657445226391125190935413869893668174309382264247369262020729909678311541319464843779154599159239282877146951492740264092136456540416445814902019457494193052690026139726460810650714396032060775105941877982847939861952499641652131397152935994218974166470751872357886294661085601704288696057983940529064074308118333886778815626358671560083967602453492299439388670597543154429434309572584709882154631112607667740678645715780606474474997503545445593132865491898493365727476262974147382356869148378313633612836279038248401638066716071798487285558429313492260932405659575536511367546443878342833134666445541803908218989832946263450161711220169296194601693206210330397448662316560035667818134431008965687067429656581774455726850156315944125073611980634728864662413271936694267129514503975189283134861928413032551884311690146714237943747283343446524820437960597328706162749109415968626253025588897684704175020031402622846910480469840324379066067377496271025127106020608626628436660501928908938383200060912286918818368423616939035231269303686137968115269469978919266352843899270165198255022529235793662816345681089130741126783781994497727654482949204388013017835464992135740327915775077860022964235042759969976269187384148473947738515635520912209633158390345671894152943570406530760852901742497681855028852763449495774491104225024537231560636181035048717591580327917983675100671361000662175660495737667771129252873024799267201589964189377620161141182898996829559025116563914223649950628500306968129735072517279185983011152775422988518853117635947860031230637260983698503083108521455957483595557157393566336808648210787912470510316315695816043487488296148941545853555619749992968779550992855274235902518103237668616095925525443199549074206797391570726142453289504280973510379677366601359175226270612323125894506976348131777544560666035762204830069042253894948677295213257197692459276706607658165582986750565728946588609190296443812850578597594375064024460621214560856085452492513683287548434387337202016923116304327056480601375879368567215350878168440780232920646231638112917722977527255310751613836821346045777998546256220819606316360192063309685162162316606834688631166215013238542873913044951231552163656212951874755309765706399550298804256473405577851913495330398886430714317850520079862424684813829763408021762970564572131621983068293646286822222799238164163531725982732130797141926762869156811818399665151003070108267031286640159183127196040389235406825915045957649183685526148034651092898965599618297164084981357029227296221402637505955199475016181058544740197649715937663423885697019822140454102096429083882488609872188764948008359444919344789313310807777408380356018922285371100938980912048532329904555985240968891805044970438384150455861501309029070913061564696859589692282764737642610837917002846890366686704976791703999544363304258557977940772699352889508378271143571257806312827293498833850459271106095260628790597150549459072798416817516870415050729577233652010032638314784794107946076565063693326630382060217195514719520412084796272485391115893028666410796969915248112769791499951026605745311238813939349197089269407357384919442919630072809503386543021378123394561424724245868250054905097821684198951540776630466486602532118215170585464816990103510204060407790534823954570811036628024193078335395185975088471185447931503450015803847094478546020921619344027984589124720529417767625064979618582347765562808249405444376505977794390801979243001549599367104079839130331199968665350178723089958743459810504105468536187166690086026518727095063078922094498504286193436294954293109720994085955858967960004258229594269439095741101667847980907928907540843387989975855690094719632489043233660363728874204771798977873196747893346400992387959284132804790765822581811835405914553958100297291326797141943540573531614158479802944118620313225190540915890191222553196537373928563103907877579205034394436105607282048657439146472804807233659273201766562230057011146855912144509955053649856433655095254739749965028288249228569590931880337949922646598620688234011743944962931319859858802541993470962010389491719770622586572667076187283539023348069250834356495374456283107575871868775381593970854006988992201660544250263128328807897949070455443295484928701875961007620274613110586720246495399705604774396010706774205747235875707590247265185322889102236303744620047196424007585416367657268920371635392194774286906858888158097042483582151491356992810750723078264474067187348094845445372649310629225803372585171451448054620766460867364272504830158120434217518693167085600083352959344267458729987350716251703005711571381753013024070110296602509558624225602890646741319080006821289845940660914873475988613959100493960659145172165306776819355721876558600653077388931209250490628043760017778544522650152062185050204383149506137210270801392037707562978306536077757366325928647365858953011561800178170369022806607100764410062540003168840377529981249455547190042489541494822410559478357875720032559664471237684403335315543214042574174579800602983082917713082714255424692326664441483627985257179752582246812204719564846717398920410879193844507863357697868887939147231768168152167068102145555981333521260636726553921369522551228189167174267189035559741529104672580692438625060986038713588672293142892391620343327393103925796435866555813425301725104238496068102902193241247883304519746316017074652260342989164540709484562290741791740090112338623953845452949732242933973062002716882658800112089852261253378070284555814485777518119353345581235380184354322962152848369629989192615657164169774661682445203114487162780669497265548371919914676148107974684952144144971912661242582093340384084351536196989622187374719284744719240730263128297944615701596967476881484379225755735032789444896030126575921998002987720122905396542336317981503621696885991838704958970325070591396571344311334355007767294918902707686149548339946677241627655147311951675116817189988757879821783910897600657100083767694295343505528881086589117067587211951593614891128230823068433211960720502186353183992210997148266151083690657111006301415107040757110854813735703344847363861289738071706512644964788393402501211372584839423856995813954657565637476063663971548025635737363996498472554328588587094954469906316852551185998779710745441588287563903866856240456273771403576082251948946485327585096461353516108643806062047390528236040530147069123230326365570538517553758640102485671114083731089069377746847929956368861770711886640773881462294837128180191710321559241500607987057229143543912519573687682238088982448959746974767810227262035149129049368822889115077490463869723017882528887064324867983149967119935102615482093073843975322668005873843094075789480751981638168561045141783744286400415613577411126912993293889596922900960405310032318338218577787993482184022913347370689218898207143551298643155087785079937015352295709988437829588173708847207000446716187002843143753441744194989748281483866434927418179804510217952989529115295358662010382233771879174986955322831643061566459360934573676220209533838311337455435570693333523605410975808062515075690820184887747333526891242463787463298297207036848194279920122736653368224997431755841896015620405764802965737706411639283600656124274527930242718781907182856514484698958989307844166763219885733320866403491603258218771672650046563027922746573906794446548856888469952701960611199427601957150010699606131876917255938986907151318947664410229132623397962287470519452771373516835620250745275664982358719100125339240110313240293530727058453878955596620356560863445813722609269451698856155856727245918467232376723889024046301478272090569073274357508512633882153203818017967012304019729723576801301149001545761421717982505197104838134595924675755060567951649416187383995284330819433744891905629838955891842366997243941630336015977981770968099747083279664585361364212373269418064931700218353510636886985761409975808193233084726159560152526795634829933448130862936150310687944450838567919383524529125004597160435444282261550962322402373162900504373772781347828505597613576092283525709520818983166516401955703409999385985215759638371453039749218001165562891592108179874742177235818010247261951186761253690063515801526045025896979708259356348890598694105955063792026162707067718087390644306123423600395630088194249193272120050585414562909637699049617062559097050613170541611281637777643062377082565860915795786071471312996038307212196898855891394480005155107065710359761518498082267043802144533530877161517260965721980312582046661604058657756565427575470268165624580553015470879936950340823284475265898527890494254552157075955914945113156734523101951497264407052337250223810767272574074532371287104539307166910993083856695345292768997264646352120149994950915423333145340014022110124806824899314675171865408622687223114158024434081610546161034178549923386446399052050275512911978337294000194827329315149427531702798304741111674984530814769799435528133294415339448471915440910253099019906508522402430753192448792335637216884052823997728810616189629901286359782815383946111778475090316138159207697031577129225883671748610325896277327349774474865345654776375316120592046501085242167020834330622787937556879835661707948539805672405348813332863107983491253431573486176091981021427979229101874508025820263636232561930962435532315872853488298737658693445244536021838558628387693371633402106422218121648108158044148550984921452232781196216717695478891598057099820333683236400840543660560960213397731321134370041157779279416953733290555689847546860131792597138339147457628094854081997114823580773194364603138983390293157229579605995737996880892198750625139336749428243289715570277272568733015593562060936647420322995103302578000433139634271097336646661490863286786373981691639308336794251913207194270439778233336565492715428384054154828429512441860192136924864167982396885951056057082135907413753597009483249106782289570737149368582861767705691151789837945472481786809925833497564131050431929905071074735720210361904421769138254077225877098258665377123363114546728096226862857517903656171356262848368729933724838869641743003095146568858073106078606338136114106578380857916824332787866051017755602745219297787276714818643586326926397144107440076379893600927865076344498613322613185703493939652925810312589979756682113528746900699208692461044703079948739387836109589924287548305915916908189355927228541346610288285838279190331761854589620529793379972937540785366652909730692348052308968960238907694503884253007950153484936908505238544937145462343779231247871980418029509120406614915380943198231301287028138846468983066808363657353390798462173737636521530555810107953833590149109533688942698656282762958961307540977007112160560798993295078135867385664900357460808120670919935882232037759314200235575651111403852388794039396321789726441731028564686443325620493880317031515593096015481621546048918615035403233749543076452816087928819594429051611973748958001216251344462661015527675073851438848772603875013059124407377868755520879930170699402300494387519451356766084988656208142725930283969440254277155903118283055929466746159464420661477391285073828270312641298117000677610212224092504509581437044356956442795847267426925751364169096524745256515429170481346514932428047685141556173442461710022652053755799305094490904737874154595585711947650935840049333898017322495667421349594227762088042443689291676237878470678272504359258059600870021318903848323784744251992684191921700167946735390326156679718204155595223009560952765457007061531156573248938348404539075519429837616622316377478559477733240437643333022588796798900972897817625827182709465857106368465281386322352299967783910650919388133511815108406257927001417262194046438720653414948648106452246614177739084530160858904450992089619297311169329114091497769851850444066774516530292781478958075008838132128356821349425177511216469764855395440142471268399165112143727355201194782764445993740716535226461304158855774618583343321700422885508182803196367986345019830445745677236982978064465386921306419220187960397916451543730378339631156967789263109277235980770834371606727813820103909176876013687920071757462097439748508491330592612324897288161594122861752895045639588199319397018229860037706411637880533171349077321534483872647053492608976945743564584071922425263896428461789693834811922511483429307533115473746469182857775141252643845544976256842191379987356275063359164555359775965709609410175643489592224187479885791470475198317865079883410852441316847315873407664016418782948852496021692802413006922494872726885362237962402814505942688905368716755391946427703539639315975421206" ;;

(** 
sqrt_5_string_20000
*)

let sqrt_5_string_20000 = "2.2360679774997896964091736687312762354406183596115257242708972454105209256378048994144144083787822749695081761507737835042532677244470738635863601215334527088667781731918791658112766453226398565805357613504175337850034233924140644420864325390972525926272288762995174024406816117759089094984923713907297288984820886415426898940991316935770197486788844250897541329561831769214999774248015304341150359576683325124988151781394080005624208552435422355561063063428202340933319829339597463522712013417496142026359047378855043896870611356600457571399565955669569175645782219525000605392312340050092867648755297220567662536660744858535052623306784946334222423176372770266324076801044433158257335058930981362263431986864719469899701808189524264459620345221411922329125981963258111041704958070481204034559949435068555518555725123886416550102624363125710244496187894246829034044747161154557232017376765904609185295756035779843980541553807790643936397230287560629994822138521773485924535151210463455550407072278724215347787529112121211843317893351910380080111181790045906188462496471042442483088801294068113146959532794478989989316915774607924618075006798771242048473805027736082915599139624489149435606834625290644083279446426808889897460463083535378750420613747576068834018790881925591179735744641902485378711461940901919136880351103976384360412810581103786989518520146970456420217638928908844463778263858937924400460288754053984601560617052236150903857754100421936849872542718503752155576933167230047782698666624462106784642724863852745782134100679856453052711241805959728494551954513101723097508714965294362829025400120477803241554644899887061779981900336065622438864096392877535172662959714382279563079561495230154442350165389172786409130419793971113562821393674576811749220675621088878188736716716276226233798771115395096829828906830182590814010038955097232615084528345878936073463961172366783665719826079214402891190089955842415224957129183232167411899757201394037881977280152887234186683454183828673002743153202296076286125247610286423469630201118026912202360158101276284305418617176185751406901015616290917639812672259655962823490678546241618579455844426596128589375648549748034901108135575141664746219518302355259568865694958163530361955745368322352650077224225828736687534047007422326614517397665174206726444762196180242203979835368298350246626803054676876744690018695720995858919831644025162091964618510574424827408722982041094371099223617528531530221210917629512088635695971690794625726032508975222970404341288082233215339011955156651407902217564616542129578780422313820785536769077266664313165931954620687206464509148727440824881281776534751686790735918624644268746419914997789399131294720145919996782576206394852625035942828640246225591037895563453828317823559839129625116003691013126590571971820018172436059551275785199832998928563860445871046933495186539033084280421827260363894454157802441745747234146972999963125109456227469597433139054978016288768106549675627564933834888459269829416314014705091414179545350938687645239093723066241906715847602921854702042023838043672135019461791505791549362845908678877098631067926076145833835169220292199011012960735860829447314407972014710152180463462500322640968716729635409696362198320488504654334438037866919275721757505740347871860602671802247420478342531809405269880566153375348727730265421256064634813863466896468712906370116270621709946670151993355742489811672735082657817248126491279071442504852234055605731208646988567460345114881167455653599206347872802657525540248735966228928738953410625449848209433400276495662573130129868683607800820356106790117544917331151045878316479416835459667456462305138521859918844800011212533573487158479449081696353039468725305378897771054405495574946719670734555228151834241026538689675059832999618720492356885351455535800383838140761044092246496478265220865438336902461204725578709086492353995150737808352730050957027649262931667276675204715579853459772643237167918072799636769165528982491961874086111119227594686522696609898993736217907139269656356257725072921684067893076388838914285333647436789836647418171497005331360797948813242107206128005216342253319908398737463218914457762184155764554407273368963065123456823538195853333104476937662274370598384326381040313726244564143119975293684710411857074351561531210073546261950382447947774449365161143194891480968597561470443196853353251561541240388608010851003166250060350681882343820385978076894500665976049002873593688338959190906091820627623243740913599573273234921191400068919402270503626920131310704069577623482998825496528304271135527880781420774176364676136067000760936003496164411821936884052892804375410680200636057633288306182787896312806385645570964829021006377650379940149724575884311791485640433314124376181156176100649353982594574420774147394812871334917840517313147957121719133068214071995664089267269297097899532777070209105459648458139969770739365609291949152530286871810187664248748666774103331429801181421134049775971608743630252200880762976081450488123285804495645430544822417013157767742498727021361273033348644465553551159479854075246382940946479102412141100798417688520741758168666852367682719415632965910742864392237900759542926001511195075914071045428986382643451128802566183610090017984374102423721386714630779187015806014734540466283306408468031074828853743081102329592228664604970880818813822912279746052079036563360689650508653477151801120864049074543858249729162666883397059878271495739791597287899604609423393431472456782403625462583317990551983844063674471365455877127466253095997182492655006012118513490995887017623859011370986518710637458283602272824374941505256213739660271521049438891186439107192209056606297678235386023931716686288497897971311685016682188590055439516670448858251472987615083422747848752028701365975698654259950245737639209967155031754356082139426393350695438958452730380326795425694781586722223828179966112067221219743435661108708071217905858163692828742785887562712096407789582514901541511502060048414532580036180845868498851812133228266457445396138029198902399095603279830282522505145656132866252331493877639021288433477436000220084369660516183308676749847282367777129370286300127463808590296293884862921790509414407481113382613844198160963890595022130092856210835510518190374263776718295319920826359204188306171710664775450760465455265954744286255936433432468842366403605762825494886337694436918785562870948199998144466406118525953222476655966633976507862524013007405768956573338808946158942095225117316750597247250199964646719431014467676664881630515563867285252608660531791634160090255774623187117549443451298940010327334515430784196819006549022430737460182439925904553182632741879372145426853852463095066087598663316221473928628434395886811278310242162162725253777139496136120233837883500544597483173983582906998924888388024395717202747321657381444730295427825374841933027575124118370865777668348584180312626656638715124417942753126195700312630996491289173084958587144565750121696290670270436345917586598234200649524441043892902107249010259768617426888790144885347029257235983664672919673927526544515138319447908766104173294948476302215854698967390479295853798739664983599900557900012091932262692672604989990296161065803580595036503175009801487037596702367206544554520343480907114331771115659458212391638703421109651586141820115271739803859443599033746235112628897129620044002850908110858546917674232041989589144164756087374378896112737836516048899926375668405498203067158214546725065781386694824760444402325255423861708970059083826400801999731133303551328190731239579563676090206071302026317891780574372217381178789427360296914003673299129440658866874859789285482510287181168696818390974030472280634782780723288039691010209824233958400240399921013989932806070172738580788201403890106403246974552646546489887926096178110850275944662950370414182050127371963359060963620147884906340047760951966864690082851686281272254421920456484675645618055953192155421698783034977463375542704478018234234701837201309240198049951705558508556331940766990116021252310667382187569319542105950044634614824355668837882369193172205960375574854891277339322554490076917210528302060817965155550894823066415281517633550299510760942325933554201175329231909935538541099247879714185101405481399562816862499307261437330674361211748448519633061410514766908315410858432599622983501722262353154634419123131295739094897854264121612709155892482906213396748422759633792764706660895576633867945745783620732816653971397650887703335172457986139286936979502968175807929520840722041204343478894052697526730878639045815476723347796235624849673115621006833890312725208600733148621695330975556025715584729083704489447234274845851168318627122573274334065614434310678529265146134612782170821773617148567717656120460668281710078194707745226902392585283199042557862270886292030546180510765420865193245348780749112722457227815663886714118007629740179732263079639171488466088394171339344458628546148276976557795117772159947740894040633366971388398193096059649863963531585365971125944602136555447032548156761486375565463642383939056010321758314425765267593646254512574000300036585951545998715818983928152688572315142708885579676608090940542038916008516404240468916126069006731629443709840735997994587070783936242663903307594907982229884889036606771768258080363563764275201331856988273550863490321081877422073743042328081164386894240896555192108338972907975665253909602783003807799186261340637323341327439280513857342777429326237838537136538399055291599543655751892192323443773621890930315773824482121962839453723851095757985263071894584565016108503381362802156359204377066152461112763263280384490900651531347851995303506160285432142861743772571967207493011426840934016686550846055409558662236733380646577061374775981427180148060981491977902729537521735688647649643786123514063912760646163943872713454839287745251741230866145927407625503034081201011518976544771269031278105315420852918952081113901919681777807524159913277603572371183188822345018462655954227606588753095018033033899301983214766787543166646049140389669480014087523734399696680326365201692523931256929823645137771504269275098050836166764276704449051745357875901075183120715890939701820451245091000603514209893966696709064767052157418443860916356461202474150656135673708261316927357773286697249873602039756559926134051908653027561201477278581712966174831523748379469169690028377953058682202744431728711983105422724664400705335571831978046289232664205303933181526412304876749523809906316593767253008418968021130917826125965543449961928391894468093022083964269537870803607651390991257207848852831973497196456012070772567833240250565321498661239316993039995883878645203447142146728507416606602286724997150727194084889295199799990171008270995511717186915318185306661450555083351686293387353561234070024007689749767646752068815503189556244376614180017477325472418332159810045397854064379952075901978118217182078593469122922140060916384254778519853922124233528728487670028204081726429983563059593630447596644854750731401710693995931082771810065367232044557695109412539687821770420604153720941360911369312098337299772123244590464781419618525860467591296435996326529165577775534904169274394212695784621335093871009523039556339805176368081585502180364896557410501195396750702861244890180440476487964625101168324641437663860138721292936419319001309858021943237305273443221483427236755334665595125370960249131536558063520789311078904628677513546069958315717718202332749691135169590542783721756508020846665971488549423793922097025280395008719818415324311799732147367524637671769016258590022933070965634289692811373049308181563094323925156893915052513891033120303832805843597709781874656062930384449518006193143098101072208755373754523831905689840929573794694741719682769026324238594402526848154738909196373005931846706902513690994908225963947175334145720323211240846127213226056299354689159547550111512933095051264529635423399571417424566308620913824652500699536230490434899479227349764409296103937750868393902386624090043210285876968950904764254028766191571162723935660462137016169175390411810658936676980942419832511273006800687934165786739673484600315023477030253824613234455282884321502583468374942863018648384982832193999734563164771851471964778969854983929230454454667749262427687252423275893412406526045011097916114616750092259846227259834613897881468517663896799854832790196887926811527056943512552438557304507921744026216097281306879233775090506852619793903523803954192638451741868433191194894350031507675348304456114130056136628671304983439946671680612830710151823194852873296569325627360434901181941178920548858526444443091890151609314241213727980861647387938641647498153512238034312261084962662343048513695692672754003040883583300233646515047232099149941278164488688902070243809763966055200353361970193049087801439819606998605372135104775937058438946478670474017330044281492910807444468696335149874628928185675801307839354802071172387236313367323372978479110992290565294578998832123160609173578292394345631090220011332108499938394820559748118655286990742905033538924139719576189390034946045682855143774388184241827598811886074100872967720086929045598660584780373184537974998422651312111568028467085211790211240738144057878631840880953671855272959920119280972152397831859638990175757205532691981080852754009180160655886944125965089051271295908598497639729227234262897154693990695115431098276847857880350806827994769233896258695848446921948603925504602765721444899276190767680305313563952901517709571031098469046956329206612587768401990160652028183660514877154134205045448733381197781709003114150846063333184944705784940517724958977509250553145457030222575654134690862048903046691308456862207935905659250038739787996694792352797619147083052029074592936294764368720104219894423883318298943341040758451041926729169693608289556060432945724799852809672701754749564900327640179048064506875985158025853128031107550818350340883925457007825339191332975448593532073460690733746809815828377389042943165581631446793824807997173878171034615960391109225702681782412216802442723414114086012113849371183293766954664171378282535885689608276936562651385829632021957254539373373474783423786292453826978916085557979921628941904952581003852062329841373548663732309393379320364532715757750121771248712535786559470926780836421754927607843248954405134539919278364937557691099435807703167840949663980625524487413247018503755086828021422467173181549624412752691803976845094545531058100879900504888078227316534162660116117641892062041652268273825514587398578605992346178568734063047717950797477787361488305274758848101289752834353722710468653973145794092613836034855594434777971888656970411451517667512764030109344130334850536378970334665609261529562658626520578645873209042042637962597532305248897497338778081235693983333083497016919594029235643169002983914421965017846903494902450865477363945172988917616754279737013196817091546330833834813410422389833257267546452750695133274004424065504877999547201214808540594440726955609659766971037905015894921103988068022154233945128852201018411968672507169413919437152523355326042349575668395128900367608205840648081765323468867818052704470101365716570886567923696185075226164023125373981599823416951117396430062014712648084397713916840136487985390756880640444474925629531846121109495387366115309935538094231925100494901561924967489981605122750183124471816202106898788354858855418289033333740083045708927615323070228311297570987202277494620765754662677678341929234965812631357613036552353159707004333199721492802534976824226019709987667421206392501340559504862023875467109707402338934971777672616066657547914331255068073454436141124512465274829766699857994051795459844807388350148685462838831486493358915717207978815019471272737763134431935270876133118787786876415196812243212863532884380535554759829115989006293741743253245304826718113985698801274548981764327048589604513266091710727267450352409814924812587792478124406084974537686475526346714841150799514874701681931558436176017884118132514556461538557731289112751602533456190505475965606015327395385632968930255494764479412347713501429338549644074976224512798815045525292998931692734803911994740567678623976964467107992995666633001693498250904591302481878192756819083380246935075056027816166172604530670477413854614396930929890995820226857430927339108687492430878377305217073394873306117712432882329613782567471558868306121895691454197407595384269241193907768765352165531836354725533983745560750843990834485667158212904122747376941709033164438631729075403662680363765450219984583522942372105835310284576224713243448338536124129769063523032854590717159675082475175220083095161119146024491855342379055466764671208674840264278560863410675892729285670398602915341298369541553791977084329594674353925188787729614978726640219778728705664898826513863487664701851657284255241894686575996877439658325007177273771488179218323953510604727229568037254365541778272079786615458612059343552051683606026695094881218643644532415411968495216527588277719720387041791964388377144764742854386069870903648022534209214619482536255814545287737136308945828965352277989018412819758529538514939762466928599053461647481144081228749740173409722519918035684995369168947364965589564950635267634962959914206240679269045348683024744464490925309265670712849325557292167974435825568617928327284447430564439972170120031649033895663785212033165498228554986700573100745538213621511565292668079843844520441718193568372002771930775453165248931519538813848108360888947694321580289948603611177867524752259383645846953690751911293684224539746327501249994236458297137920894505552018786868711667839033026597124729178629820372169936696067618186547252212410959194084259733976714712080869425679960249960441893370218698081575690020423536855269015827537521949380133151936608703853335312792184529769134042570148964236967220581537839298680460128350634696782951783334404613849069421525543958504999465715378077736028356062759896730217905444189318260901331331651707834938097374529980509353193319832909473026851951115479469701305687995476898102781165886026001673392291133949707558681576255443158297442143851773817855575746596596442914846654653197596551390179769061248044607297269544593411304825407177566056388014996115087803257157349106265439530521421528630622478305215443872428869219217951745386844734866322743714915521623550303613932420959117028026013940369001405258095898514167424035055875710991525478249117429666402034072368104327363603468285017961232126935266170100836917163325866818695839820737182610757896431730340236242022666001339155046557337103615651350567229898984149167467369162738281595519185053454793284695749322879963929616207341013201047653833011028926942223373485635463900512128590327591931895128997578292289385187325861872960963234811961642850868105042274266481622782715994324571620283820682092113858156499791242912008209138444283366178647332503523739254343890770999710296855034673848240536031985616640291660150896948466252877561695617011220860981999872869181039037498968739354551494671934176669921831489487150079720403279533222855307390534088231040038782968586920203025906234891775296614074335479230853118279816607515532604261981742543977413806586094024821172301279970599628351560860696160717640640402209521400951142033884682406821783128789565060632918746087511638937350506990646026055356470712023328262235599219958732408689913936709586150862265511728637946303034212886437849958655560252992952895093415633161481226251875054369481763223095963661563350209561858282790912926232116253810350790711383155116082134396246327681055511210454444752942376646644619917013794203743500956381306698971684651952451315168379705828943566703464520597157258588693011273386432525534763249191483586539778465444133327216398498197766293705988198277346889209934168488595648726046587782071193120347988440397738051449094280326601922429237441673021737637066812124403419903165414088467408436035339269826739199212864401065774698978627193206084876160913188948667135663345407459272735188433998759043" ;;

(** 
sqrt_7_string_100000
*)

let sqrt_7_string_100000 = "2.645751311064590590501615753639260425710259183082450180368334459201068823230283627760392886474543610615064578338497463095743529888627214784427390555880107722717150729728323892299689594865087260700978054203723828023715941100341939116001578525596305945741035152396802716407373799074041581519904403474319453671399730597005051399692237545616097119027378154991633288287704000657570674651963497752083793818114613090876473786595624330579947981281632307054836501077156179463611915534545364774948205930904948498340339890021047861667332795036939246225717053716492578754832290732492671346980298949908037748251109227895568897919808814834090831685251335358295391722117707144149745769070819894444414589722847414003035023532037194870738262931851936409083228059646278376102195979419708909635469586134118179306781621360849101677835321255633463490021898146042255929503669562418692737327715022087523099664698132032128189454785680209506359624466285500761905041393504474371234885223327736251004505962108067233469812000430051449025120625731175911542319445967260497833404344683725636178255048160879406205511486397833055016369470076387773745195116580952204742020649821024440560019965909041002855340691101022611668072007748307033261384282629680950247079465649634433683051970882034805048644726231793087695722489377521119788376007845603903658809421599292501057753682356001720074065236924732099674197780025357085406177944428866815897311849381016381620730156426470162984109969007134132379818847764776995439111194596767033697245247536774010024582651593077528163005479339717508017899520565284447796194304512502890432970610508746044929668975422571333806332470345088882342754098062145114395538033931907053927381452060433523818038933329473147905805567070416106872287810452995769663303513329504704245502510500789645502552271857923370921821991843932537781386785650143790894130020990408601866052281313298217352517164196336178530801790228734003371095272573642865092203591634382027397633655096671417781629289427988485395107681910216811699677176780863793410667897509217050421558644370687652934899322442240273649792906668420703057822571105379442157900132803040784945794315181204663092841525924046836528280272245853077841589423897395559095956349135749510975767478197559053372693936521431268222909570986506137179452721677198255442288046052307455488310813325041499327834681820665834473833668624544561694972517742702546885917462319423093550603889923535563446587292250736222828429821528790362384759555586164375547202736151800826144981691174794610631845652307625691344410868551999982851633960745717970829727764956451426556582051262403059616338683387461342374635264312965945270102137217217489914355293204957509711425942720798892966523049887593952537812145572319331030690840194942118708515205734116214105775416917245804962369512932926647583857193343125506160975090039575120634875759795492954992247266340740188156349405310529604465875564620943338947941762395628356349713801694732220066791621293435973671100587608647371575881684122969500862937088695418127695765706218647593705890746227177674315989867934955423190387742224446136993060888756395652843391274399232387968832906207071598123918140197532376623874218833710703285322771142186264479238443931230317870021802156263998733847453103345993606899837633245900690816758898827355721304788511327144687241520353111338592288651345874819553041264322213678583855423590638618452700487231832136684265554753667165760425744959823608640542890447143374413527216575973366727564720357457321402931064380350431323788424731514549384903622426849768122808352574866163546646010620175786052993048378210387191117674718316840267143474839354390876792673862085122636674199255108677682336995949767664130615461747219560627489330736537532202056798649880001671863618041955309396028757283709888318004585769283563572097327049988024818622254114445188211812396056809102453283729690436738951943637997079341974788168885139428215328113423555715996732375739529137268807984747292245466870530936722514896271417869980500986002976964399874240236749129336888862332000291880996962271949986510924694867687893935461097268191476537583989507447113490414817455171869253859459591406692158039259150200251233841771532335377771441133562623485744370057936674882686357744269817392446075271575254145214453269672977196708317754248517376333044949903502139078141112089271184202122989519450984107822959655314980705636858421164047096965559849599650219606644389127462654913795145250696216490279586061067753708277274582900137716610589203916087776132735772018007762008467256113972695544632129805026246243755967488328449842162440716762569896296303765707261679502460078979197841773862596299531222067563316483973318489852265398165212376051648275412296241825243571649098629157872387564320229645113094736976037742258960665170713858206085945904439302758064720076077242085026875085054098045522064130392719051307751601950066177113335220294857981033416275657093398039516124042717351513332630177574641739426802204936108332643844702150525250280000631375821855226793326606927200078066975096981241212683884536969022355380120565398755290441622898303878504589253133207213113997911820236415222965163886116994709493957791339479276218550756216216209697645177428331876248945467953178903992008193959403210310790653540815607217656002628651066858334816905836392518024860312847329626547271683726594116720954682357322814031380917749454908600420166879375247348533858056677058541408042124916415231717570106062160546999810729767225121183067315005034685995516701968051317559753622351601297333163992381918279893372956943266221754913636727940496793761358777675628416390601772431036320605712165331232229570942438013812723107240517288411013737616135380955808932247723569730050534124089860063237421220262844538031656017699002317861148863053999206860142853693286197690606203959906145185273942808641918396474035825795806430571984845652110920058455681781914675085096210003735220675439318675013094837257535813476410172638335224856994460068840297946669638399708740810797261385302460786358230931170547074503408741797594283973053227965165462872006255460473888091472904139114590210209845375052541063485472950059411129900908318154293737430344916285541875301936718273904395039783362364980724027263837332533031898480092324763285769204626157988159562362654797754612834109154571105892270631921417992012344505479482390215936802209190912367144889334715425046063717646649420333679454681814286096275078901726394838917676410853523135337623134666657082717788331941088811151290034088950596806727232173855251816791477663602920083932266078674308371598326767758651623047551815571039234344989662326598864712076099020006621754954139478008157629315332123170534454501756089069297073021117781524319039414323872919385135326400244141301532757718708373138628837077557377550151098576238441234929066868632976729288200026707269803761085144956481370706403748276113974628241590760584270301737898491593263790212234464820228999301833677385590100084246670979830738859298390975575960118486078515926511530519450037717006920766565969625045582330117294534795540311990721861829585827532392929717397139368803786289604739278430103040382236207507493365481612063224267065251845971785297508473087429118698282619262334047577505016671568983361453913542090619703628927768395570537056827059221178013279212812747291748669390288072517136221751551624349181642740516899791680344243484529108052122656637090347059037578760410656229994577533269489710172866983188837156622172886752186246001266662136768830214106899507441168302547214550109300078970804361542174933232351165089109578029001323643355408867793877741529765306288960003652641499544869644827281459863971828823907604712639853351305264961297589292155461585982236196210334906357704114156678334410584977844782157977303327288769414012119499568522079447227431768128893548609797467891277830663382197162994755883402126143408438544578485614986094734597436112494133315562296273850463940514366326090607193684781457462592307913764153586568333556524377291258593896527871270050551601024435524884277499940014587653613322468700900664317717860534558719172279740108496590416709657242405573211318263778610730079889195461911929917597120925969648676369998002171075484065796851984768361697908619677007135834565852440299574420935175287328004609314899903178759658188610048971117317106048366601487174480752897998782553381104304817695804582027774770489150085104377075257227123548007237712086585401584570878697112950092404668280725006794531512206594317013091252435135680076500252708495798427421783933180723041463432349100118931373011641327930932013868817470775836373169726951868270435051576692281618526424767110503024931704286760131795738464455796115871317428273935803103843119387910076831840070252863894073059994877941659918471144241278086456273878925566156350764394829576260537929680552372645393728198188125861937589627244612671953603617876166976812502509475009015100629843398962835714621296851152715699279620897455949014251228449209580647983216564650591713271548205530943628633531894500922767763362366254093881474673170987201374186532487577091691581177965494058704038689964700984868681258926455113718920872766119116466390692679358362328028287050318499727379236455728397178350820081430826339074341187286144658481718878385452194452375299682672141920696541809090074387574013325374235022637287666645682706788931333593008336698955708756466645112114989579187284767956864355310789844556004498476104772104546511218001509665403712123872051986219143271028003614260436497412665251153454621084465209547132954296698544956432708218069243250946228614370986081041500463153860447622208181575501101005967219299377665706660425509878244973074444827975618331686938351016864918443385276807469215087600612829302925721916523356188489821919889086362544238306312998128430409851531236004060378688194119909548909762722744738641063686120627661849841650344369059048450964106672441136007721327658552298059728755847984732050231949831957389149778271702829165518760102678129055620628182116868811036470212421051260468363703773556551863754718757431482087380943450946490982890479884400448867938040290432871576343449934736087126772804544817817016365370423934196574616707429089965522437015728847495147933639927981994897244021805087591972482741713109294580822587626525215009901680900146002582189275960204054345996202069979741389447468099968300813556815449136972598400257310668336336835946317945283963236774864306629678900563654333468338518720179612963731917053805595485027279857280718081265277609536840867912167791452332286927390171376036791432086950130757726883747599532042985979367005954726506911644833607187488061312914975503555087353750197450870921966873622665352101971581018239955333096676068035657609325218799048259360114550971513006153148901894005498431945656815724306686730791390083351973317528539661725961915023713753952324356961658765246684106649528312537247839211169277312915599259586985010962632276508729103276333118982769165334192859861526108789768453979252510020631745338004509448342467935832913483699010250023217105517882519763808363771200581420326063617447604345957748757330029577592173071713837771826311745303474538393751854466563529589321040310767174891541770431447222450833500712368882827640414459857415119042348404478917345051586428349531316971203900218573943158652552251810938990320201395313580919891011243743478330896602299874562336815450069561731716610376399557306567940929978694359268317015899611756395411435436643589106432283237475428254019702469445694359370269929379417256800252699083488189603794860604692884042959419633359371410580808659192328786717513627826732271210327117415572994675809259275615610605271812924009941585476466394262909521390565713086305120166748200848607923651656164524373046341635602280683516898428340745390506059827565329831650389835257064731382960524276848277747361726926080311802253355383775465167121760031999611836203269869505594604276634842451361004563496125099211271965035498267001435910350914502623684564689394823226770005636482096776716184960481268378308843462841396701615795556780237889003926363979384363640117398028610767594828269883277272084224817035779772935636323042328044920276955017289695313610778654093665063322709324087078466264258976771361995924785091712930742028364758156341295187419712812652937412118324458506347734723800778422992529893310730059882380247483310998453953921790800116907267727505824010771986346032127350283252679048590421123132256918948149190496822016304984867079362009989843093045002974586699985878046817788567228852089181328517384574025620735179717028963577704312317031048267874917984547543070879001820448412566399648234862449645801672237581829103669951300363907176692705683135308535887032477398207007558038707494578261767318180495250803294383184351000391996651069251828897949197300537376236464571760516352233384649140274886866817495324587659073053899555068901680065168707251220180351609436751218713577049965171653123565821559999001854920676937082838211252469628274797273204936027954400153752339534143191499786545237574310357832036822165272413114529922184603280855629485060021048791692468139653247936203523869331467403885115716191929673909028327850513246395256379438379284325764665500870661295649177678144176399154967347944990562602222519721237405825894421611090695586058231672601010646978379858813278169549273318752340600867704520004934782936937039648968046303626939161044893392889836517504925891463362242964794016924495149710012809444457823044641426462071573930928595971426230876950747932339821490554300328654274809276799530704579787762879839656241724424525910138355318557567039690780811078142411331192763255545060968806838836915913091589445614301536346082361938604926110188197024206332040018229708043582016939304306317584987612568108290680590397188057985954996912828665276222639569726940287119134612193356952313107163913641083614043333119276231207751924901961506397207457114253787359112694839047053932991961830287674535222233817993552720608731547898783393012593988040968084522000108092805126575939917764709697404109807592175695389221433933445420821031148740589159894530611396101839660053261857181746863384154224637404212594470520422300839042234782879237490947162040459216540425826947626766020198344138341973282572471680490079472531185233868445921612221082180474276620548112099211493241411541785049093983690476519529230717361926825617993036176223970373127083932996022053366424164351839577562684306135153450346129376574431686331406827617877109327128375990856394021790036583605441307868748953326880534450940271044692122379400362385290823471383116573445059020077369371537620813836375133336725474474163993279916051670495090546795350172409829650911360904536319314173920210189135529462568681953979820396578473659062878634777608576778208570146095663542068366069444230020006469495401540064109235247311830206595179051943808592762607447729705568754705095032343217800688460856101441142764462491311533211004361901036895535448818842712854602105560010602981101081821697394443044276223446344967644434569511787262122351167029175831057726518408760926766677321984719158207637856241172569993767027618820755578738554264388202028794092075231817079517845436966267933742559157883321257760051407661998401291799920776440788114105338475326286216984018519138510027892833773380762371479523931768550861550889470650862263597019909342526172540755946649690396156907109848286064768962907920308031244714161885177734408903378602104450136964017109204538030483017465919568806585193102234649242322331316741138655268933730915718570357805939700104712800336527994032058871858993997819448258937192020421079022413350357740720856685765067167335478285353361256678314709613216682470779595825223080410590205955417465458855278773058220651202623852419342368438883932752154391261291669259784832822165287775513298215569475469921446370084123162281330712237226762517805367077967537951646283777374101173964881048852200972689727932023577010834177442962168771021535157053407754656713841600242298964770701470724954636806836310071440622968751552978275890824813582933681148661419817809738927259184743198314622259327157936190775396182688729356775436507376348270978076689813220901487872153984854642563192238904098088656455362409133118976362183982095918099579763192726077659394071730102705070407970572020725273745997601494618569899052460767386168431825608691323154591677446828506634202284384191594163754055728014551725224527771394334685925853329724277512672678464372915956555829649083159629731366992222269078728023198440403439498983080466828212739442873231008848339433142836172587802203689876972962438299291610245818518306206253147309710648590826904387934225503667238751044582433775205167294932986148114951146389619408755924681039588194607388715369625254349646269125153747453239480853110195641078381156652001486220025968584232156883861928747370326918272473867782862915907926302308360788764120564788433556957161905232289909348521437145180142711061343633604151960208030721193582240754107221875779583701266027057262201369886547671960777834532288706410070199266501493317240418762182948926363939601444273989189232651660987904828515590640957088820967332640392481862826906220166268014460436912414009558603804135460561863814515604459680730111182769088160541179402681647280794570397533217242435457415899537513961453090037192531003971347010149341364212110060424607906388359379490234876177557838619199767600823227305317069402275865993022105101090549702114990037349638723286461245526303748143997889470353242001726498615575865952909505355179025335124639022412845030947082570808376870760310525563077164813631749406490185284641537856202458436476229895622392544739896679404592744913510595867886512664066042135175103832560072640940985009425300737436332631279362640655882852985473689694920560031555188135584005206241746686063364544529589562133279640296209392497614096008127295724362286017689364425795138111596156142822223157860255375621846848176618125629463736805343908132200655361325026487878740865201219516942419050872161962945650319064263127867527729684239551161534367743434238970228212273193460878151642776335931794633572775182158077396402908127741850634864966390942954136039144073352079760975922531666926358118625438299894957190418687442991176385710044085707754290329495520488205868424829664317379372475856928794472759542704858111236645887277166386355657771974063091761531587917405251539545667894092853877192220470759049029932191066070583803334360225662989655310665179189105967892971270672083689230265703895887933420534546431271083793748490303376349536285465164470664909390253005038832670054876038540346132374099805954287626287927473137680927563197701628602956829577481276425558014504729806064076036047947034112541550710145200846039695630839925014244107917531273017690816635313304537177781105819368803340652294014717309038945553788053875457208952686558765187530967535220317637318206486324949239029643039937528665820748565002428017450207753788855081459160746742549232454108310559558785543514594892807762227454795835786182407999121133276805840157681779578985093808399058233883278227526656812105168321822320982862147344594013749623568748472439304309829211358103006318866361504234050731800199545175964486682029156185858144133133926663295973346927284941500203178474754421908243243622097918285693041189221132827270453341116475537806928756246626026159476552987107634260604367871620164822844287680185738693040363396306609178864320135121374817965697615638014501051462002694185811201106017893252057274585745635969387441368713352131481869884852426591299072912401056371746556348060288607172983298547302008639352669424069333217034067704984428388740738074912222880565652012956373266044513477936318743619221819160818261936835440019720614303833287835478457117265384348768146971586515161744241384620431709175227500500303535493329376470154924941911175829096588832100707685404228699645298001898834268149947240596745027964140276709408939792675994247599205082385627807273866104147137447787964764039072708298849166307371654947789816329622909244156764937741062498112958729999787906897037855752200971187855153556215835829271580446303837811212021007351584003691211842677066419263432231190416517085367575483190774947190622704457435442627120817988622400218776041885171577425750234349702429672757584445447472350615011491169966058933147912982486250167964297539126297691103917992496765284384992696226593328041140042290255910020724189130702358523208025838878809633724299085413302273728271474684626673604469530135158472798514899195048759564651960290841509717782657908510722346896106434412415353037279607882566809719241540713443946578706051509337556522210957837902324661008578647252373463407661656450482701782925044831045251127057439745737621434569484458291736984129843566730965974166768310580469731720360594388663190672405189054523413388674425949453921427236795401468828295897096723652978468427357956254399026845232868880576211709715968618893524669373479623968830843066086336247627524627509628112945521438155669735958790694757303239286140322462795480692053395281488979706995413892011053907355303983639550064644859811986873880207412725291818661980515086502422268518147511745864503196419899003228570476940098857422150843224169004027463046263871000986240415546815810639591214186864218213922177552424547080337885483607751422314596905804170077409346920305414435270956921206425873594393985381889281765576537595154329940099442728939958284188976475409149412339558839524268677719769559247130334287459907277791974872784065091281989464947657924805333569699835381623053419406449894956023290069933207264848834627565150035866433588111302054168006661701622893669973123623822059530252470752744280819320428898623115995900956046249738748660392995895695982091477023760043442922023438096943753089490239426968655777201598775065058728658570038535291029795075516515599838286144152612916403474835142830914324362355977446381758444440695026719281788303891321595887714841962947247144125041645133163080429587448440373458636764135409394364279605820501602136457761083680625935874917737395563454513975903372439420994753841700878389697625603198012388585967781721126679561008797978353651874000370772056575556491109762892447536421206598190925209920920461095259413979161282548589376649215508096441922921498586510746539519843290116272312005259219802322430609490081905641424463973076650630472330346088839560123771708798106398041157376195100844501509866508962394482824100993162232637688150242423843838361582718306522064851037505578146214032484039306125718171287375538295572723684277496729284394193930595657055447521996815348849026179409446241138661567863105032416741477810121683585868834903399987687554309315402730012191398499493416799938548740676640190604800067056044995814113631299940843205893097249579393695891663504194038470437904439655221312920653524240176757689519050851425826991959514163205487601162787555878795231086373734196344883032157553938384546302929870844804003671957119241424911649831443316483165927641120210692031980481930876629925812453574068196329406282296129149285413721145221237972955821351159341834410654096934024447750632047963520628020967844875530026748176261675225927353593253098597817939140268478613459646638846240536730659134118537296705750810298356650639543410030522072426919163157979166237625674494447275421880590365807647411995288471537695475560895151377858710128785423125749195039013901026152965828488834491898179569365907738734785495957708473792071756834482323666897276828789231135305797647974264010586387260883470553969169814931301665260122853993339838274789609875053690852379465691474190971827586249880107242252247507975332875897075843663456207601117409038361860993383112818986642200835279756859522047539121526821856335707829538764658189128257692349062480733336444059108375472145453546316001669531338023485648743952384962085367479026373731755893572915460366568572008076252964037420475383736655302816177037053164846168787320599364021635159974266780727600761816299503996642261249926876245026979768365216217615929940460492727700352012833523996685576118143394295947467482566995469636133653673426174250598356692217801370353651911143102522782071402716516249637934985031055524067134466960912442632663349550875721780110253679819558065376232465044834342338457255982184137953903993467621993132205364027931254241907468867627234500213223434611426546728007297373752780049668303063390867323881255540933336134755776862069119000795410126316613735865448817252769769514739942600814031291944816459012775939979721886986348426958907649478532599003875335766364657634153943772848572054604084537656900503352415115277145122442016982187672516952121436272770669785457215903168704791681866641447641239980770478763850380725154270177691912427682672645086394624176676802396253201284733323584094983251187575574267601208103357884400424798169068609403024095070187931890694380057624223717543188143977597160861776879119408575603048347933890258400930077292432114943669887538886525665525761362810746042394230585590701366679421020886856084745926926384344538078171705052153247305910313338616124649978143121466778587052086632789382470313769958584243993907087911292053275723758555549056771616323204197411701817871654889121851239314739295226114253340863825864790510419938668989267951386816096877862965538021390991613098841234661986390652237978974400313855872816795931439885961835987553729053987113394778386975790291174320542702938913731634729125772679608907965325038705768983279531748269572642682792015912707563139652288006277750620364251543212998045286424170656488612041996622678258872454914272857034693268944377257791661014195057793510238343349884664780063124305832773524793174296241283572353513395323096460284109207857160888896779359891354834657676301541309825027312641914767814062195015082402158535835260768068778921587948462560506054611357258863534195176992893832495012511632029101492367029988664006357437497601650302760593235052838355447738324491131843495052948384915340468874824885425959784344046116958025117195696652081742330821600273673070530088217674562034326828911073002031732396373645280386919797393296621248044363636527461890144896263552725848720573096849896825975365177219446181762701310557341449413153424387376538559334544548923135863315764924033727564141962059231043627973638637150152770862429299956176015360405853072909614077334425353722666410566147599771972414051774674352615687512670631932181554745008526850967791822320550142840624954238434936962230301068000907579855887504234642566497125468703535884422048239811066797042709597167717026360264869772125520942360781470021301729129380230497277193218671685223253711432297249720552809283927550241690626302468417748473414481526671793054582029200663984509532931368548150321188634472181630602197161396915980455101320994987662978910823575762586893074636853977572375540263994149150135781172369944754785288498680805003223897586035446651628152382185804248299216942108567831787083854074442770696105525186853313406907153066033218616780955854462091149173486130283302448403578486441468197253590392549362453797299932074717223931408702304107919599657479893433577363052054855746399989764948633276898891477303510005313606469545673218262248677997570663577305215992079619048166641582772699473310740489425342888030814248470479223932761475713267319693047956764434222251498111806307827677885048271367337330422194185354386230516683270916040014540221728194025113929845574113988560498942121399854774469516243332526726678229558290592065238818982985985942059890967899992361153888174916984010974291347880440420735375206732195721308646176597200175670438974687602620259439844269362735061559169002162698928294748249682587737683156211790000058096172482445992538761050247232234038079287225381455457273352846874958930225423433267307702975326838648467198716303900961777929948623492019832549507332748679180781477444908616434632547482561986483015980589129275832746474741371220923687758736347339482512809850900369975648735193117931622903258514677463316888676886141007320901283389889129814108599103394976338772158115440001155548176980070123385919336333096203214090414303984530983512558360454905841041561458960465356544915469384389442956984298624688358071024210523844766855955940681485290204139011808486596730963418136568282397771672592236975701003028530389297473695483603283937203623330753711023795287688905261765198247051573624609954850511852513074663792418761455177744674525522502755935101969126026202919140113064123125686006608393653442067126289573926546155287832764669771338318432415421155021902711389934891454054126689165912510238444749552209670097937150620953698684182862266909078267987083675435769309270627958645485712394284279714425323394342948187544151297648847317406518574584758959915578552643943859515264893943746889366406200945830081305016931700148754895446230531542468167165168172670547582881785781023674940452161977403756030157838857243074786498878802857942595899309037727579275550071706560199377499201858756098048419329868831811373702414654323549836564207089927089737459317089766609698978357506325528646787460305957548324173988485898322864195840772066156627313266651677844700608865935273365368767135661904783156447242018835360647242632674260255052995883258242789267243095227381220808365325470088135042160825056956244489123798201177100493554176877625885871583928471392666105208772847522795723509766215518000496826111946793538545503962770544683712716169324660066038162593686173857621024296876093427085334287263254393591647524651833990544297186055477235422169664932255888646626227754563489721812628863618200841555613916165984412416291019452663926112086961635695495727304178346619042662452389638782065790119257607142614117395283640736974456311771117442442659410261920752613093524702876939502963039609718116009623822007546601517769985197437941828384057402492298966092323902001025254605452159749109279872012685071954701318203584395958162801918684427902420113183327967389603718394520786728574032854031479644759265433453822073699939696073412914131552471392187644677346094314528697553683516248192440587044837042296629943689887520394846085338493030797264271459365020073417410299041662666051248588007999661803669705661431456145952660956936321566335120943782144606343655042727749795898169103249373702801604445256279740755826614463038928816218763419907641085134184660472370288925397065798345912737958580661932165140503525724338981334338943616397602133612826236124933889554469318616680747105794629816983000569100958805422081631095054286698197544328545483594953322005105898388609751216437127679867517228376123397866640518149492508164022257347104480074795589163538996461756474423415378631998877795652229204890691417226435819478015602683683516253432879882459941995799212684788540197679817235180149639696715474952451587769196622561922663446203796013936818888833532477700953518020070296957464900535752749228639587862080882978647184840055432433924830404331912723284268357821273214590720327960212230263275259334878095158514885191789849050332350473101835885762647177919833554842187626097300535017705129594962266772497955195312555312161058850694736963305434682501278724464924945771193848484711203902209835747746709235260795717363896571126011774271218641201896072597572957055665342562600932064508381479181209922380314331427726999833643712468189005900890454043975955404644864839561208188009222465693242954153064355603239206658511470623939122799416501612139840163575607709834227828624572185930846414706406698368518966318478666512489895788292914124527294842452249726923691084403887182760733991869990432700914974736445226671536198752782918845378930158654498533064699902414184692582615689372565062229682404361535829685720854366012733454390053319883942028569977589277881942248359456791351653426813604872782533008098941075867135028986218660301268208997030524707842162438415630153308325543961245966834359893804880019929603395822290806206865583290109839004338173038436218207726740862761257378436764343401707503512130157742396738737410613257479239680813324927589724249762150622584017606922122353552086656745303847009997290246682084447384136607820131770130006316762458698249870178662808854304079197935091265382091919349385929798636050230488118411935945839608974754550087111712134833531181031719903424026453208675923316472145501021517949893183173592359481591230404363975582293352192433640774324568779481515361206216335622997000953663436368459513443755526407872453758466048687910935474686876042270121849693187793147059864038658856296458763295681915177030023295765995473647117243203404626177922927119992548641920361088097806630409799547807604841331650146634808474510146212077090104287102356874214127362027038569376143301246296416788580159284882581701669174195710861142942057461956890931502013491198254433382817062682655326911613043572963232501074458826226866169709655071630758930183204872289240940977132711517073514194126318819575440893525977174191792433243457153765342491510636851491815418210800390771271067422765603542976598711118399959218419433274332250926675695123534836066758890156807092472830702999814029208173872623938536276931331770852969747369544941471672992539917879515561852693501031932884476986197096538869490976834320582772621766644787037475760166283332958156638395845558479901161474673859935086620592185104822227896841583314275276463144271696177853594434881137963038345097885398014074295897814531163536311298755687384441936333364637384376782490649634327276914597588230045434639162531071033690882216183017619276209318041780999669737093022192573431988898418953448172075247074364821304114571072315879794238765486094906448655271578738553696723811744715249285811492429870556988973655860826474028849884318030014841060071760476070935938124076897329204023868710015163527449158015467200138999099722485329315547685339670722852920170712324714973963988034289421948073864567466289216889006171143507907504238470037118117624935586833654750538149168680949866243114413004841693478317953061728876763666561983386140469874998014683883452288354603418681714382328886368879140171407118123238913668392348899122448676619299902919998003542931886883396160767229054963807532093236898152799753385829714466126722333188306887708027231412896568623294953488083405108649616605154330240916155212579392370898206896134166203263308834523300401247647393668975164862937781547857172107766155153005626456676802409054409849412988960586658794770973981785066532484683709163633234951970728179894654258083919948750958091082636425797431407675652667679913459733589923536913307606429715372242738772396581566446734199076670672294015478440935331873987771896471767089008369373935259711337347663955477871208991061028890840876447581195155349373056374118685640394594121138486872509440634499128803380004972360928378270449269748221452882929861908234235968398127460797768030434048183450019569744466820094729797406640694696043367958645662611063864603227445575585012715164915204929974269709692494568695661718692823050298239334187789680332580271592872980989874734425861647178276328587526720183224683440926719472205554782975568844904741783255850318968334348433082270598752415320529145461322502471973707145131733879468642165707013501898819848494534439381643934480372273238236719395443351959842840670327204795399421725099640964206021243803892210871564280686927074937143740678366396549144079532768861134968811031766646021395448687807544205389630784300454011667027058208514707729355797984977274411846909152525347659057629672379849106394364771807451520998509979910194713274728605044272571000613862018490929699146583323730868826332797900188342701961789053769460004971406597426897803604107708174166931957439808728304124700937637761009886461965488458332896477069194837128439277811249693209225633745148875587486503919710981998647001345977231505740391591934374038333042327782413386026634639060907546641476114204250139882887512574738252429641325124666900369144176062831736159330805487298732304709072856298666600172215957357466160631059047478137101742655265854644414796288182278377099406347634901801633377786477267346355384169930815082069885980804515735726619598413969324949858363642440492064956694020586226248809149616539107850755152572046140596754626054844742996350880230976466571532714986325992833470338372534227141632928358610261056653660889305694348627586888363439539600756665387863424365103962802208529527279251346351888941567246629787774238299294164787723998672098672551705963509294272876458378040711448365888766211156027483381653630464375116809467737018233907170268451143288495896844649533964871478377714986318295440629205763480362692518237639832532811296208414550354082586083754586764177382971321498077851547318493060994118418237058112888638118019716514882373973032165168450853762485438210865356370359811118166944172219021577952107384329932468846716800055713795739676977752960418307813139487251054484805104975432155232496253664587622127833387463860835111521948447632134554015280249837845720888778740009974797770769263638744340441035269718342224290258316117652545445890166461933709811483969804902205352266789887686723512703374143288592983021337503946930760115474405478829845415009743216619026024080422517263688815027036886611901456815061167550922646864590361359618693502141537636565684273988677096396659060007777575990648527868169996658399773770282381560296320649237759763598780305163608972519030276191638718129868753637980968259520750414251578983233138877848515184894526559929593546338603981666260583279567186862759672495809485731055006681159154526640928902063039596740869377672209205167708144443615624253238122245793873865347422860367748285272647685610038250020232761596642187638349720710375344205059745386007306883893401007629266641886374884016403173441107107628623918610336155184908228217716924218200917044437124088322321352973797414418988005300581433499768125417963227036095250128904246248404520140691218640209521358610106450004766254713168210248923743993490887954044376244427215385670600562237829341562319479241448990659746370754916246790249584075423590187241431682858630657628550825254468023191422829615044638976246678881489881132052203309634114924014749134299418673013362703724852419049615153123310575922006360207192206421646399667420140049758784068541530529781630015802860639299008987185168710176076724643118966585388568222149434289368003373870671358776550037096928827736481325794988664350011407845985377601450716333662428578275653947246314824002234716351507497168806989720460506546179371478872884480353356792678346777742330729564104217094901437897276690461652623410264530116796712545190574051810133070119141607145854734466309422823299086319189825010607986303198561921360033291202576446799010839616846949616792973699899905049335622410288071345686676136473697333416488140538225047962765510345327167110824049084808319239849403199635779135999050155654617107447029784879543495050710552180220256343085177248663301282158266786251172056764727794290829042313848517079380516943421923705594136999066147147612319336382043723204611038200388117617488272668694726309313881312296920111123923961618850851146165028028757211874358815780583707405163727110415264118033201992201623992762582117106725170344696343347645625195114949907479475146419653861349352276715590142915903387450363343268691073203810054056324289003284887908291993622165181832191669498776983991600058008844422256110128280064553729293422023136328560412985090098312002584276344844890403184993148166233351241580756258469374872137302939165843718790695559142142804201617375940696291615014503534695833566701906278262604268866038876616582975449983707976027986288688602604669914719167617605920497973269569492437487542603981370625685702382751544078271183571494226142974410478511662468286898316599373884926233924387575213531388065931233633089330005419503447746135903641266692149513430314244797967950899619104453660412986545432556051587653784349892960614813254093675507745521749820175399877686133886628784681558308781560360461324792592848714306806575032642216594449003602202208322539666149758229950577480651849984790257370511030776710832026579889623449817207607716730704337120126631598657651071055068171038920020515234175051424261921369989665300901492841871594160625324292134632689515004441565353128363346285539420892348447869120609260506927968859897686390978765308306758100847186738928542781913308781458032156571415093109914556554250114980079182650582759070713111185956526585085677235411804209334181919669661812318046416879951694407178522630418994867049436642926826546082254107847065812212467945836136496379957887801666936282408573055186073945616466676261672780400393265382181613251789296481131044346040733475683790905204360706485274058871290459156867170805231149768075676486445515437905817827539328464841777569443956946027979078443101765513153792435079829832802309349105380928257805294019477882252847670378821481733017474978620177363852818603183190613869278710947282874901953962140010755184097428803303082291793424133792818540947970733816840848553054319444511408126025880837827109030611706808423068849862541594069281811859582528156944771228405915357952431462738188530808396203707761819316312188264551010984517018449465188041278159268226553879835938818369614512607874298963899763220063591063403554318480993593159556549033181975925935556826452544043833646271030411625939501915543334961491026442471189690774608400792285518130756268558655352620930577848933527547093781588078836211561725618441140351904134939523187037317709730820313705566091780338841244625657695185518203542853414600886791640537426584934015046621248673813425767753521864796421756108701823902177957415615326866040037413196100446212642646429854033506113638933538825646228178857771745916208927806656552286590048867947497613379848474362954858804547552182353827222823271621649442691107393203621976641436232267962584474360518786388459858363469162605684864042461584736042077483898679507051242082982538948141051438875285595299656434599204320764587729505476473837749617137672126500339394391562406070824681432340722111771233674827051231713830588364516223687138947832892542228800471442010138391927286084234577393486947599353256899167941095679123336157285554035417459564827030508365125874309922575162376132179641568476581675454005038605923678483825603363937294791491063816307296035920757184156713341177664035277577735380524287645311412258862192827454281482960743220738516474724323608296816996309111644530493705907150721127215185452774911113374607649412185473711931924057380655459151270466364303928034137294821351867027847018043174269835674000894752995619111227227450088369538947815317836362576413410554146935562880230583768802116577695768662293089717270509268245767343025478683824213957440023542510624548550751010975948184676715886520497041440653843471290469055460358924531433065053549671450973776224981272888399037363379296278690650672741722701414632659020370263751594096175751762155726638752278093193298793363474281897638860802078350795997727711656251053454532762022978243894369729491163839129810302205026582029825039106908565135564337533341773634571829499304526672796514930194578555221096954350809179440865169568772879381025186861842933310633325205793821725550619574310306310072316931245388712050573360941289870454747693003920427287823569115190495358377339207102672197091979650115492133086274192804559660298047953255483958510545661038744066517302670920341898522434795522413654346271144619890723905893800910374061656046391156747414485981891878153848500568202063058427200326162015357349433806547396214587776216170976925503491417944284130302258319432883769633362468047896658573893321543054130647184910303821130464652607630442266765973456596676326465265826858073237525886508702575022141379716017460609744443677210285768116268403673427416085096734561289975692635265035661135261031088288467724756574531742889416932124448808633570561715494827361849510109065247010926961157418293811970962944359599083455183217551544254591749357449217942757879753379115682253885435012316328790108804925708412175860192928904670727847635724503780031733971178302991874791221031135323709006573165981605107014206439729669529464345453556849542134653493474764263484699621245753074055393049467374883170618223982298760156317670950087180141310675123011124769319344357309674966245931108299592206269842616271637041945822270428710763246854300489887454035340903511153942107904578220345247961634123099732493657899315212968081364471323157831375706994602612973129656321067074740960011731881222039532138488171372797306938788643268794819139997489144825370039870312538471558806889179031433962038721925035385235092263396725029821314907316281855843635638029787001531027501180163106043565027820788968081599883033738634950518626392531848315206585065884463434231347862805907955749281643900227982346551144318550351694155411859192222476796735218695281305581753444747045832288477341473536756631716350677612975650549657108740250781877435456936254194477516459290086411767035769319924356438018287430588901794225437416967910573624148199056253759746931908186708382795404760522462731256408989788727350432624296063984806805028455445098701000850278117199328036700881805540657399069656415135487106883447872915770750768329204790951522245585567749622836632398782206345386668932132940496866870459736743986393612571587770307938394989802857851454617582673845461041332535882717565074744773589587339590863518723212972044865876616138906095994728785353970858165406463163269146632542398543641538682129147240100595489074459787761160168693239097025996186529294036632686248179104074252577313741355911191835900794932947508275275846132051729978473466557864061910755834927531190346484514447326483637198503647012052890940432175077839845856218756882473598305962482304054720519811775542881370018407922172127718005201415445397249831277842419088042907635180153641185912198612415200675654282276537821748204687626676247439663841358239491991609030746165409391350851509791065364235192987708426395599629010569403446691335190182196916805285271458196740778702820451369275811706069632671995542181344464587937669834714523834931436780284402499355671662497354685437218083742755155746900232494625234087503996490485122223081786250300567866460660198929612580235107920427495156399303015365945392356729642099114949251914823705710114432169743384419841183345337230573067234907251806825512871623686449476965091610944242296205930979174198772400184201763584751628496564147035019724414708635037675651073025479186932365790805204303683621270431462686378134833914710626620620217367601864145336500917297096333468165967791156302528606210468074611454223779361689173126208234854573626309746941934486194977270695727255301628695341124476599177833053619517206014712649945328458898235229315962363515728819801188754656160410546689501810611544700441281405621580436969540578061090850537340702141400043579336335612996139589783943945532525133815638070762387179586320418522415210843716882379525646193975132976470906776350570796318185964058537609849277859748454617704540992207073720934684148016510494248502248959089017474805754146882262324517387186969075261983603485539442823837006705066314558818349149248270898781631809595515323509635587843872705901371100209978998397122846704751286562073677018732857728045442219230193769802385039140317998161232659099864107515304247526575194537166860170550005978918937162043802201371075685492443376217646859535847601659968516441042717985349226827951588228401775038252666642389591138067066993518535129078730233386952815220537329048552921262776136909250588352985184554745434486964458092144373178668657208720862169611502066972771045149938288586525594606536051243298151017158634377496827571677651409888335767172134235954893987126391054987872257693463630671624831962887594757919306897776431468497738749087743147923344612582678304648714533177816686648347224891900030175968844190716884658904788034168541026822170499656207593604362804221377774398891806912333172699547269066599794504393647197708293779194397928491596274025513098242121369187082221517867251174441460696315003640460086233118318065029046325885311585804771907429296329562462794100871087305911931165537339071938138473427133103152846494107500456221884571741888275228254296266530054021713939105848493883368298028138911462277023067393105454011423349020830109200068807242281016737700255454746867373723908556983711717220604999707300662092642980636073995177980366700092532799356866279834509997771626334512264658897553148512398416476874332828181024895988549995642327750031537369694244818438451188110736924688722117985081838065690076115604354456766406304779521886480044402806893660918733000766704592476126878473929591326312519106543873615047595628152482529579857770504996173963249470906291145625738970612401033630250476861886652474250092138738914732513839723890398900321151482894163451826288272060976386526716743168002080999193957328154812723636977802549146196481969922453624673718674823128268151018552418901767712443100595197761053278975881017051045676336138161071836892370705066489498618294736488182074034673606896911133630732189086389018049414166178321178159031806220593959943183486745714745744561321403150582155113424680748633273769654920109278748839315853153870645564097508767067090925964841470200611166446528098689198594341388541815221717337025640077246537729629895989267335720921956175465251214161069425280701481623357059091033258973565577107624459291009865756130934690464524837830361862859050807207819041561688141196146288642456231586615664385532495131311516609968734381930930058611555436582653408861412680065127658776770584657695644877442404091569262552810311731807092458410243334427171695007963648486816281004151446551799619172306326038451537688685894724251326897502212912342726775277623346677239934583917898455731641777253025181249256462726616700822887058043498809226840271783297318733123119614264258844771241333311722688011681551575847697286377136660109344609278032542204151474000548519958293168318528701607988767672810912513330070284827112665059876921541974355630555263260610051236600587432907211790593700257655889404582279790135831150178042201675666861709547247942092858318522388007118854830067677244494678921497803684587182471415884637853808686480082604210973451746851177121993000118396689735258114655174371145718217690733195411612367655721071681492338107273770788194719832564703295984923546011622317262429260710718362931855745206131439874409291694273989702959596694467616221620072838679539662671246308052967039776319402992191156059011838102974790018762468333556348658801796030598561664145145891421742687089309808879203708835485247958492047979018879290118468488760487853140288624714996638723415935021674023794786154553881213291244745794805142038733582800139823525298068277726932016637682126287338485740027748048250196626463889557435389565393620300473301498237587596398104407047552931754595676548736217676167929106100283074830500426646011406070668628392378361584481384748253143539275585326925488201253798671424286240663002782322238699268776129126019024216167341865436377098140784534279843356122254202854058428329359733259487033088372698302398685454808394932216453807313296643412948234273016527164423135992877453978958347410054223113369974297586551352185941751415970640009546083044778776718875672898775773448313896555928311893836537117203479153562121231836634707868629764044248195707585233149825323489544395708311340756257397831748444099416648753000566248332102361835958167452244579131751963064065801361243644053871848677774117635813414464249386841278419482587407765802689460628035307280303181550340496700251387700495753515955890460359861932473351168655217773639230706365170056878326919094572151510448649979219370815814903383225432099087856831427689194358222821601487161334880317302149738337273868414488076138932949912504526923383897623581887869148722959079173287691058598923792752600234828179242495520937822878197842853504226027814679306527595917705800594247970026517223116100083808619740280632771326553408759449483748493996822254288486215381003737050718609556227564558003628745585528125821006889151236318951879849938593397127102084665389880732035837666637981298051549941973900176517168201415091403140890463239453516655837856397761021127773438433568761367539586608644464068032405690412322018857771144592159139782171677193832982696290530489227520031710539512876185246146043277671557590856538302828081848343955844959109007629570302718853682220601342049415906297284738161006907361200861606635393978811889414796373894771082825260773314466286635541997969574860398237958907095768299733637119041528135078753202539548638483014250441772900463278698104431073890246952114477378386763958491237244850536385109679198506604970537803644573494652233342337998909367480248442432888661888669585040517595383230529741918076803280724415015275993768257986011044902163608587568275505097979509369129017655707746583860433860903124320893510367255382141156344069820699737711852910725999140835819957782474470823705892391110521895840979331068243137910132028291212954597054950716428955546542905254112682092427924625843860151302246868895852274315651851958566201907144972789541025072642419413844418158673469916002685864225533412938241234989295775363615671552761679068447749759227758500012854156102798424904015661963027564509130702916134622683355713509689949418775214913093535605555475939626584122626412048214097866615552628961333012081435842938706658035722800495343090165164069970846671339388747184191883384487868019608607148340272832616210518649703657124039416935176671292822211631423816093432836836616177810929268902770063375594401238578381851546407708673253346250756993221578127345315285139309097267925442174410133709262688700685279532385301347968404128827332002753651572356813269703743238281224954739365952885454703181617677489791526101360103383417406508939615493343336178430927405084044216457350895743067946153918066757656924092551857495799441278410959570663778298442151517736741583702915218316790615006744370375746211371708037191833470569415073487977729746022611371053230669164793700639527650295012667075888240082364546222707292445700063463016903403585054133444003495492193715508234907718113629709940802520059178151197188447363980105955553397225560596354191539294899204465709781435388397752063929546012141325449006404357648507454410558818751123380660428503193595859353799819374371636648306280436699613064507683740115444757188541892167578327049910482217606754543944417402257946859034300830622391969310349907334509269179683259977016486028525688084619058273679846668732322452789323233303417945677302098513195532866217622744846804627194961591185618075504148629379946040388189029961734223759143860431550768642576394241087366053797819873289750178472416208002749698813758541189684380976651193446775075738258812657743950164161166908554120204318828955793718072657611195946172527800454457795272861836717846042687865275886007806964067665884901076398352515717048481867928660025324850245386187590426054682117728133753491499066684266699757677239530158428418548720778005426320424954044853839536607111096104267425555394538496138327612753331889515881884794128592080573850091613020042454026508530990850167689886797869765219327361901586822459090233521126840589520624185439607098177726656858630674023366980829517725366667402026770234612734072660130572279829597541284688669247559228518685207234897168704309731080134104657294489522933508124805271412300836146065915087484619085681571831641301944993120907061941440753058445834959009857789160148007544718918005910377698988065025712020784605775139871997851396112707281581299216029965288695618424526158598656851054743575492790085929825050182694905581454471635569620058503445152741531314476821311045194975087890714195093664236182094607717274961150623949956548365982322150371946069499871517126189952742754137552102092047113054301560649039234535459140194111183562648620959099048553714868246253074775105435995085459181126383511737284644160403001033879093314081707003441750458560532640810223411333382306018033274464423960219001150793766867283308768097605701633435803687086129192320657171532765171077868954175477812867111088550337214715852384316189442405804684129963219690235416943503424673762841147998473610052519979390916857205639807415527641980483007553508814518320017944475847138306793113496201722257295908365397861843301450657741329058888822132195941916806316317777701575498104989414482075083617422902112652089690780657603264508770272636784499512784032515133965934650674240836573931601212924342802718423499563294168681333627496710779977837743150654197707821913519832518424849722475661098990361888277018526121940709473239279007116706011852869172961060130449061523252390516529612877834816004576502004132721283066415800186469675626222395738090177791232200935973703643253608738072405141477643607889312397000900041302091532063935449116284032047608074388555835240835361091967130071647069874529001172345820368268529687277731299020991626734793055000270086530007489497842699192630612837965783433311312272291164685799451828747391562833467428118258935610571114244431697715110948773072385611394135930604675002790968287620308621132124901709229990608347581192547493249592515025574142214495776649416987298458590240310731350919491408645657441896098311408089144458365543602402345684517598534237719519238860975468952068868980038593856893012838535834971727164332055780120217542380339767831540560886532277111905446536447514549359308641034111893451647396518685083680820942360364844278996945064223788413178406538069532877953594459252124205237903191309744392731566721855967607694801744859532513740431618971614370161930138485560398261765615898711016757574145936152568283708476774129585546892304761487673553919475029474987526203079649659119788758874172880464472841288846236070147384148284646034749284459591149483666306841443787729687098826051329788609992434076029947505909003778818632083212747053405746038677389383372287193941211233052753306120357246979216833838305775560755253720893207022368675471733972105348997384876230223592117089785051496241718366630078936584179329635615920442421555050080820578728236946839658577011884070258965875755344306383504076650579103242994036254562204139758624143247770697823487740611707304388553836168586947550706311482649798178776907156683978928544486767485727108675377156657740509200668892010089169577961022398465431012010709032492105862148064661015623346486603587220897226471722347207840279879015701728636486913504167644328988290735882812975584323485889616476233155607263031486388487808124911433388107344824667282112513044184739697374309288643410823038284411782483863865392029682719819300033254503730206890748170577636968997321357591216539714466136304990779499777890912603994083510011277292684394220140207419745013321054629352891439566226763379673421763622061328365160220179007174847401346974867665193100750178293628776444649426844682913949498817486701386034589142509585991313879832212090665707656579058757669354797917681166625671034923264976805704981769736890498382572495879980192997170210247095114500298664098155551557618368922101292327876448281956376762668320823193220652014744493576799761604201529265706690443249691176713187533977150010933160475022517276918327621135365138801371778011055836545473901595697841406357314853425450818092785191895849946744490034161224951882764036754564113842997043766290893115974452840636939674590654289928149420032970156903556277305845253594869322141995873629389430225542135514820295806228114227407150065406721803538846001737947602510312878776049456467142958941996555439645099042995624270389506805035815844026107888903403068725909253063390468874219215634710280127724405992524374174522518027363599055198181202569302071350319557649549034182144691149355532175326157859943124595366213370889652221033959945696361625521763615713179836934540930674803438579967167873155281011330960562388283710963855280387938504592718853547679344796845348685467835181765616152958139959202654006296100688042314720224654669884751451058418977851172640236877111382926018096198756859707528884993229981011940504186203131167044580268566960150663976582378732184563274465283545746566481090481514744064534702034204379300145041499348613701833280037189916672446821099529455237659264674340502126655707741531452285189227356927044914631084762652920519812012065543584619487481538076715398912647897145943419738700897885684634841399870788020935109471083713008994696664584190759640673614698365426070220445725874237889186473332538680088325971087373607620419175586654729051552443369107213971830644678729858441893347319272025979147809080538248428845336558338054121963694473700212161501877367843368397907522877308865358289716759927794748086966435647549742451268482669399530754022180897355571120411860155516887274008430623523119798786228870697694564919077212099910052130846322451440397499008504414048755256031050975441718507066186374361992076858630262379428408373362434529164838221822945218531805609574406948093674046484498837818941079894596264934971457739851576298793954028599781682730582175391435418871017940825787491067701868716276230775506181328877595078306064625815259404654922864033769498707021782024557432787459677788439357237856360171528092309554790787524616121751691310110147302035940188747961453077620687167380629251954890447387084509779335316825000624140249363935496815645693748095259011230699862899308101849989992007398932337120865151414199752696435796836907936552532281216792034106943612800142589787351447886674248941985928623766197356157264772902065541935354231690878331933046277848109631564401043871890725458126392895742839983716541970703220132016163756203803209120165287536029386000981620525515366744445605605343835503676512453248834837827500587096695450488720358331726071803716905103341387174061332444046873370140728242625694906480110664731416201919090638599806032696462096596698183058325596293441903821951007211070167464830451121972224554165186965532625109060111813159285656620058888668514457784765761882535706727753794913933821164380694686316794359813135781120976977080466720139598605228375846858215294534560981724384506056011057659875948100966092053134304997506339880703703450966173680703476334612753679169809725456602224261236300289845754779850206002415986794442799720899057222376131243551138462535458251390621113023914263187345076466154839381607381475695542368733092896296104283916453201985157829763366430910503132186453635222064478282849756963201920627223975321124720755450252854764679649138973990264552269215827553341260165318785276058296239356568065464136921005007297183365192353113492087349655250544815485970354571945524659716706387510511916561572673222609738983877788647149921968356136652768485971391883401769281977237239259798028552205718783944671803969631262318947121944662425914625140232199967743420686376078953284959619921511090520146582293926362134711778508184277348644891921549265380637569939949151551665922598631264721176235525538581672385614463469296970391294837574177581536112294815983742040857670155767477986461974506400430627242944001678097346586669321063603875962173763475503265533767171827388876354305755427434547066177013368502959008557443570776402299059578548693214379507679874863491341005314727702535544689562767530239692833524375432608191724041536805501803516965236209636809224183554415918000642629855493405816882565086885459534360110458461978626663584074077152482834578212391754282453653175461588856433238952323983085955337708230138327417835653488632109175695777282983014831605488365932518104895619794951564205691133963577677431462179042216928586695616034261424090829398200815008724410835758074195675713119500886419493259440136455155134422885429799700253114482077374800591916475840896330854292599187297320051214590344334540390888566499162038403214743696262698056627201387400587326440085117659694242138469024697574402576594665828548701965378061945273001822040080116284073140317884001103088909334725932220993422403010934442757145771273131336889807872045827397568772080325556629096868457081865133298418657002974403798447980709318301527549807665690856507622941554325404248383357109971543277448333647875632936682252361875170442329501404177603965610529171815083979648542015302945646512105916704924260953166377689756888543821133572514360184675091937213537000473591228177174656724750363787055632577538258339184462113400286465026288007729834221666040707134192517858472583489129048391576306772311874760103302193749342178193138553547077132243531718268429398610498376836671807155390005988207731191529610833644959288558481619074215049493963040311391259187237105745205223693771401112712356250229630016722588759112909990506403905406685487016399626556556063084961977232330935137891864895563531482266881958908245639240128227545600523964594729417760784971473414066193406016106124468967678847157579663886726718868968412276832725552566321480038131459201362093206588593014681070487737575251945243016895109446474212310834199306654187518891616787434479329601114093671868605992296695292251263050832415200662971747276890047264260879721188456698725306650646732735745995896082761721183878869988764637816868134856339126797398754374745629968484409260779690601161372940712234891651836391099344774873621610790884671450310766076969787918978741837663087881723973952459261397926448187629376765641447681255325355691182675887005264669604324756807483815953497813815944289150265443073129851239755464523452936617608018460116649974999113886788436026492780328679849271338250172535372829562493717120641690023913290263110091004437985297274056321593271135785537334706798359942948530862809014329571399889686257749794031790269518578225734657565473101572732102833177785208024248523379566525611372663179703481333602016792233618709749727323892206660243722400635049610202968856638807369231703308188521581087117222162104502834259728615086842154448925688317251771107011266017701389254702997312404765164590905432468233102259586305284763840902969350121568288479486921324869695923773049072318694583679041341543304217057088448885143461055363047455734869591206937133785976511687255730718941303031082352052891133697291623821056788683767283206807967021462029993860053914441446365366412560981901963269016899357539598002887175647852601440107232548594526177031360333809821840378176897819499658275814192791948912860800881962550928623745022940067521264084790283424521851715398199956663006552010376412305142013704935854884290807631500110395874221588609732363407885715967385768798749281987726743435169250835805952739675014907966363903178940567086035365084915861369119465125975727037279774611816374918646318704663456027850854600046610953015771232469497916114845927015631095583634984171635619196725653826735303695355963286921901524553916415862008526258908160934809830739132093177343740742575367064171855933239784090016780794409676788868354809072156295617762699736171044585998053424599573633072038385528154923066984307004773383674248643950853780529619004322081002975271578644879778899742607460580974594118663602985649240512522297834625761017994889677677462842530901680055329912638465023954160543457174207364939458773336505179154405249044875199649567145406250871340632833922800999557331878086051128811088829653613740754754661753902626810786636229970630936256945971163333719624956167858305315361298634701432386674259987561375374195355655035232733632658026820192429697804980476119341929157007404673470914365287516318006817730283257174573906434153722227303752164664677955896790145856453023827962443257802502974737078840309103050334399230889127896455447055396413161302521911447863211377021196579755611307950683980038791255338453346625235839217353124974900395338811337392723676858351126060931183439222038835684815206774006813879654884665696375140695712347647303869548058625870576163833855269924094100395430354707311973018751416956539063265588075679163934571445550318310974591018563753638065129307268035691566051651829127059413912595076407541674529742632601073405639736057013041163003258627804273472358187493784556682062286460742746247056849590009094198441840450984114029947870982699720208110555736417704520837469496055874777722645886695001427736485712287735428956390555429107600891354998645075819164232341400507062732020854550486123664235215149761880922307919553088105369134381276426687916074900184400978082306350168713600856290892552972097123812537987851986688817502611640382520035269665114704528714349917175939989555249099333222396221398476854603974136742834129690663811373006822323065377027547790417016491937179776289160029499863320913095563875041984095704439097919761412900288481539311847938028540402694504538217110741033806571220634177581941891666037656532630381818681819607579932035237665130331314761091155736150514848089448567700381564379006244797301877361031106047697969452608495987260685689947318872691594276007703828821514026859481609195116044141585688767932491293387504409270861491576115658310467176340069846878926504234356622076712682576767184076608834009398706321617500881212991502575103663287486869678453898900393749569907220560054922651353059466501203476979826374264096776422368239359186548660301612392882841452812006026825822489829869381868184927769879386525661841288078560379426922239357574169371036240766555776322586409661138360967709659666261363840370010952949307524544750843348381379855921756859629525936559131027411745707260390396227725404497602809367983878310438401628791428339559382496243787691504348980996402255892911743159580259196066284808185061711708868036135229351341726851572864534953443392985884159359229073879172944978824433588061305014565625530582723490803684134093449312364224166192548905794484115443530083726652278357865158147122986623516920880791217453801346663366711778985474124638077416638389228207231358265921173492127757226450587264723519851732168329360566629111992358131970901320817596541807577346587268838282343023600033121770235602129032210349958515628079810342722572967653512599166798726999729481033494332070330844873072143280092170358520163080108164291700908148792323771861126882036753221728051475121292290824451240714490174976275450989610715224827447887366472140921738239776297310608197110357718757800028309154652088356493423864940897931519040363821723683487208611604719784810943319264430365136087609246507506613825255260550498213521200556243945426018561291668733180324868036126895983624489969308037339987526085792385316311232002551082221729318552590388445982218000200902606729566945021292640911191158388222599798295718396421251060342559572799693673626199068779863746961838609938861821323744919475104563966034158173797646479025951331085435352806513492600277908006020715557648270787046078799979151465296071018399077462385904611236340585269814278574713598796167126952945952017883745568265360700037131051271402929713838147121521479306974582546029066214638842466568849720770800197215191957157060536460712578109952945248165849806055060535623605602378050021005079304997086741678795815214542976857812558711967954137499175048604666456483932444307356985753164318246438521804124622599634153580665764244392006635281942111428509004272438550652583699738766588240465063562991710040847381438526754923378900597376041171397303801515044107174382061571951980783454794908301581662822915364845147286491178917518774452474134059320876944852941924899559950476619660550561630472541205489035492355832095506996546630017164154214237096533098049830804997848237551663120778914743905094216150507041283116161635077357632048551561483453843454293898377391167212096117836280843514415495691195372697864321305836050713521897145709628306163511976568477779167527330058322044810265837164121119823895815725298567973641631968523942206517080221559271726775569807657925642312913611772009199265632410391149735066708484926090153922870538021985575621939187701847539487713777673543509090280652238304637393342652643301890502289754350739375955224791000249786451041853786212664893145900850326602139065123825794400407060242761161041321546369265273537900338681081852237948731437766236637916036792856936871021586195760301745232453246753789423949829493967687580785149890073948704677299584905923878391436669301791840337503786014699215384020991278751606516479475103103857553796652449753852406594195916822866750113063594012323158859638092335465404976858324650519489780109937284791703870854800748861033649458193883044721535942886376843486899382210386634080647196816402919577253007404569968729772439444382584483395707132283302175063391978461025785124191489890270958502857462370196423893007005265788487872142999822374781649789088338134025523223275846783851432510377342255582275527093010898246264821568397861424148857212272323491772882523308283118422956455912927957742210149333771289318753005706148512979991041803383879504345648393870252263013836139244488066838198289649118663884413749381080004851866515490517203433324239917646025488375939189143119533730336437535799216973514221870623739706478964023197526309158349905330970750124566099962909666974589006418939454533405202213852958210838028150300651178012966438492218281335003695095191072244327551357658061762212712555166428560292487530115507023609084242893834257677787765400610442333803239507293433442890561618355753757900728874275247201726275835793136286598171746660482213375521356431636054962452348814397558832947064513929656275321625988810521371657739289422843132310443504855710412536596221505601576115871255858898640299703125304237691855008052840382335800203734105247194262150163792548344116726399421639462291280373102160646150498857274848632024282695934941721330606113182415370472062278763411664551441966253670784616832080528937881361275067516307280981128508861932498297810989174274524931231603919356462488956678053760907244244446086085897583372958444321606556225662697815046405582098912018948827483691475603696011619255502598073007459688744726207902067940028041355730704291154773980681495660523133608269377916338657635090423116989211561394594462323871617495311233768678424763801922423758473139065115012427565936089906948604469981925116989586733556166467350634490690714955565867682903608598516754188391543195550688557414609021305800426480157386570874176104958747994545737972656182591512980420693921610916499765119791118158952407811717468998089244003478530850666778704401199666205585779044527812470922689190780905519725826660807617127732268610409415516663067292283244658288069811234039310675017152145567865762457925361670706408819533672481039785100335932066207088679341965945553085202349778412093524402738629096349603006203587409125358674556520636575280169807185826145026545178449243560074248835476758639053747927755012300342217854030464272243435930199861863354873655789540896021903118863958395365777605291096037053798283868342642449565583850601946995573539856322773661193183239886520398236914935289647988722870258685837797562133083641714090360782915212491621560652057622780493244989547643448150106320436192785994080152524189845025719826278402913820976027603691659469307682148773716828151579006992048377887906008920252203991549922053895118529286722842461206136470343229334319346327007831512226105791563361906873619014031346614344033827473333496356424420975278162565308075502931101887482777707795548913424310015225241921422244762325678310571168890806803918531460260431556448157510388198431091325199031435860969512716292577132241350263821282539468249645344920775693825765431439588942580739476906363572755043324958975459193928904644958079210157025534729949559866251101311160358048467591443398641341655681486523329984581529975527606152392735989374845619383554109288136456877582059545420491443413343733807692985635913611389672517395191451917598610607449502349747101448603560822492730983484338356149131136881949521911926798065660176373021920859392107636599886055730351262685356609232904436338881935280340990440304760424621451629360540317506273393754521187728382093805810992363590039703689976267820821284374511395362727079869218932510136774515177926739898513939211776914522023387772456424933893074038461661653331582641389846682640683172985043916571589046733579360739175472293020574893703867116903111093259186695888431396211468289918067609470749265796057584122955665141296004319665487309869270247294354303134004288967729136088691613698338470553775322158791459936727996224961327536617157383996778822025410322862670334798450578014845857817475348791400312547820947823717668425306905641249505956767271990588855076949284948222964368703670281402265779871735991356691903326856423165796434171460196108633926492713601574853644712729069364825195807452676348384685455498350291364778439759948269570871440601965431582360893983236320872851608601108030391961817558370810493846449912607059104965710643585400304566888411421029367312041860132734746438021202622429944211501182306256768814871137186131656959920470810913358214286127824766146190371318319397586575765314784994471518790752779545971927775495505368777981612328413100380606423614763267746263172862498706873481440619849017530811065939132474551506701163559478791131673329713281111390289117653279088541730745813039681174797968204493350221405588947419154300138166011008516722636766498128848756912892696827212555682594609200135551672465478924406609299391914130045175918129054056933874835247153434446719285828336418952758764114647776348150782314090715417895616781960967519662155523688485774759640050474856703925968921085306427350688476934736905513945484559781963780219429458915598615892274159171805365296266968976074726215413752733318846148030207680023866025292727693254915921434871438429063765306005873180682745310067683558159757570173167500023555702436855724564544011513038254143116509597570865149882742763748737119143694979925323763975173407265591247180540805489570718407567242904295767584585383948086462502834285019769008246713837875847708848796497838346116229458406861609621186891590890767007228022837362385194560055989330953829032519500261591084472056348452603369077591755652069445945550063744509320141422726659960221312620335799872742254134464314662175495798239470078595774463315304583806918467438841821384255618072277308856606245772016233557411066699190027168486478176205575316072468026549603687682814032123127347512317769053741311970863732684717445849042500484444591347992995665448301453899324408104557263029344638887781781578586440323763536212221447605296153635888955082776516974008814049817796650851765843025844605915792560610371750681346552150470480764748877063126540616165962335853196984932294289343985444444504228047732201281201705280497623704032476906938778800658821775938480786858199486466664358725481627547018363713359763546936610685458292824987111071681810342097919141899855723859668485953581101423269602526492946497382117520633632464228505604085523688326577882055403862736352865670932244981140966058964214473421255993427972323033638374133599114395893730669470568972139061735986560801271558165755396695973780785565141575529898686155201436018239928083157941634532878448196339859877281549591144746336166177295085391475127932928619192924042572780009014707181943548987980335357816462902514128617003479500133613410651023744302328861823174006060881716944952066608513283809460385990927051968108027042844057526635361217975397512044041742348925662087683181405282090082238341022138566317534389742926023525698932341852543511147973624882661746513505903067878649720235652735872154126213293602162505800776460364732004400387679804487921054055040714886018066187106946780787647436849819146178793850361692555470491797429986992378111889747973594196345177744130969554760934782000847106543730043330733183055592606331024994128034463729371394952692330809579092490396777019062712220583445569761340181192137977406883800411126438621327958118573592662487993629929403103627105432398252287511334438977682350210062797451818007072397377331432753448415173872997530492086589051038797101373449786064795542649021910781952302883757755458876281260887617370167263712787669830268207951988923916336072314373625882544477348461823148156434427531598287615488516689448791172138366547435481789405846109956785621612503833073521540711429969664306129105418153469948637200603795717184532884305012072438386625080325570789699126618659854010907892828682456656135570557934169191775255295264576810673555655282236467855543382078717568002758635843149997526230989857434747737234975153998927481227516260679485355117001384595411646390893703161227318050287353585102949694033187871134145785179508314678349514018450777562612797308140596775802875115562750479862722548124301303221934593874436283552541713055566567801720606909106687930446067456888212149040495658962458025708512612448759122960229040321267293225702798710950945835267909610549666075288193490286230447849374355209220907736278126872041381776520871419373726032515585403452381013337533492491068493443383900478409088836958691243821420824470598168755557984288662150183821035093894707843963103164295902563487384922701347402928342807694093279728183338162255219513419343935200376884190278603270660933201452359516507441733606938802933352949191290203347946921423835442745689541798705845733431131721252362988991115250857286303504809345452472734200228877893177139326755017622248960725497393813447922273170821566157521104781449348025467560993242887953182650976047602053830800222027953952231785320098842607215695385555897195828108131041779576381373904132573539562802265882236058614566271531010477342930501393924022231642989352115254333073643499402757701441122881419411588244998709380880923645391998101487065835020937847141272051749169614385002050558433746967925242977243041345607509833004501784092889421315393686762145317058715649523040034144807491711045047927802190592170139421412881949638998991595879917420332849742261565445439149326083670149197664051902924815707040526455102882600338525010247732101789311531633062530551291082332048762083231501730359004823649096982366786707663141606776684882573426541716226874726025219450444148838166540732192662842464090233932844844359582792792940671206486710844039526192164689167461434910823498814903812034956883494875141318182645561097298987918317469755924199087864762814521393550459406680615962517971268178104528734222533890644926320501650124169264188382192903483521683114995957600123248160883630631452233901331333520232978051442448644030911830334113949587711333032709676323950777230565347691943765262822110653153004511424803895098813487823674691349182443500634546969288402700951285414236319812346067749852477039240127752433755073474807189586200161731891117740555869171693185000299255812814442997838889221866153576968615459695872066690296427538455866840815041167008640469102088840497898488188187429830455792653566019352959579854914388901646137602485325216687427514103607178390322785692581447241835274830540423537513962646270226566771570129205732584749040723915289722473154746591570177986539138639456564340940860427173277996822665480139934879532430836969494049724860607273955386712917597111026249352423102167096266805375351855525751021646407860668619913409661732538332750556782587133334357019964089084846604607283304720404539899193946010823920362672841527724491597162996953716692181926659549784554428261619387305456410377552028598649665123231962100989657306127865361404354125762756203270713284474299205162224416896365745257806045531248235278842328195323056890390000223256332905607606200719720374399339022792524960876175224214786009129097264247770099356889650314021274696902348366777409736016530468289130151290293519279921349427922804486689432949102104085911383580179213429359440219454474561297803861975002411550510806675325818017989510040731205620519904076297912565323903163304364973200115143160160630456282355337115186186269031774116519311587853857897668458840352312852543309390696417593774100824204379391205921010037769314171398641271594662929552003145711492630142707388521584494012111062003067538059419932447037356173105304385342615348940390924552642735441558880599866766742565587500782088687305658576432408540020253057895958951690895840387956603182585876978270347875599948573484341283290058832705793075258803848493538162101243376556690292861681382285768143287654649543419684823190746269670092416764656514740133699378539201645384321057697688242813602023964508795617659801680518249919565561391805211138176500785992674209133065519027120968596883747494920332890466404289826996502306180944968066145588264272334016787474209982296416061064237381363023093568671669582404754270644550842362949883925485229459830495670025675850043625585418169309419047120223384743528201254850225352667069282843801706384588939814662758708870506073523256558889364526283032540965879817922124985905422476499216939164571568879983967539818893323652211113750840682825631784419806477704932843809879110598310764205194630567933985125176128000074849194663692675446404955845192774891792378223623228375155788878701055684065928873343703075419306808228047519127063021795387254997047810410004452071151622896995834695881097047576063163450351642819868848823519341643696860309328553810982671894256409078401401589887261308391631392854880941465308222788011456344038076747350319562204151852930778635842245183392598949243835850714262358274712438662118144473331171331681637775980526069324571487939148649457933178913834730817628859170657355866307483576125988389116718311170571115157249765927583858577609216389780616925505208649669284363206063934279097132943118015743546723078867439262188529117435330713949995585219134664989318015468584104277527847015937753687245768589626323478472407768106789046106307412537019415888778319030214134332416839244281326859081318475997159477924448764455707830405517277505021034934373777527130116317461934719752565809057646485434999683290007195608520266938809760596517637672288133099027273124914170653001917833672221422536063339998578727186301767719242274094849629899212573744350889844521939271301913150164445894586784917574123105544420287496990090776828714614724612627005296520339382160849441760451298730227921710483020229973195961605965929289248343722152779117667285409075350375793051222093791287153814390809736158483866781708598672168142764059648227973521110800107622594841031905225260274534385131025715274778371025302896073234984820876794874554398468752099243402818514724205054157056132786158841037877164812112201484859383801552615817456617889105673937257838318517112747238761082556777694086178867701914033483232788399423877295326866468181873293330857367610777801408181447012674530460735910532996016824489147789158012366228246491755347166519468174311481926586501406365471972634917689891771206390753812269431390000240321125400472439628535631669556794473215798271692531720113404979149200991793707077122225201502148915932233759618013874147875693863134347235282986475106800168886421656342348586364982297146380547109135861018952802531670823927005506155069372297143345981443693201306216052513882029983173770657734469959592672999663622500780102934928281080048474290651471113648033283119416886596524557629684755322740765505152958350126760291918907016069730106328862217107536607294651489476925953837748798245286428875510170839762679352074767992662826691603073243929300160073097784487264528299942424303123215161770588482556407505684779543447246947703645477625588939507922799792912982181215589809536337727664535836780213286079368847904303145369638219839543967151875855752652009910904650143992530686869326229478454759621762597446207384155141763420282867854071333335911130834313897645448397554083954817062308813739524695453423948694158112984566828286480604798383114423919991180120142134919712575405065049941012336170275441751088680113523694912456721066190541666092197134262694966129923890798227958546415059583286648132105585695336850151336589118390644060469491126601681256304503041867015670897290381446195319274364033182090703620121094039824113930707085694592506269265715771417458671011260808808649159504070345341945446238210019982869914103235437230258435045963352877451668534125857604814767965679340550898395735938402304845351861035601667522352689872689986171487238612769272375956626292914547667201410679352081891903763110693464582552568915908240502386848005742548112910456555626983796436534480533791831993165173107175981150504564165839269569458970695529625387793409878849882701851865183404804108390103591367698689776797396662843433325283794394057254212207435947687644063652507796827948447984524758659301655558137881370487870201837350144168572703128987367763009785881228281152169372859631847225436615057102950214452786482215366079983848514428586920292706298605768095662289473865318535290175391659766979452703574136687566542215236295662843273065965584522137654421910622858922254906888754818145706998456492758862637731984568217145961114054330585524717844447786163516609489241802788048242752937238814675825324630194646037435510768051232259746800311870562719544516499884496068082280940708701818445965985884211123178297872654679898596299704355944212985344780228370827886815178109600862470267892363244780297575282920624550216784592637867631236795949923736936158787226584242030366183531576305505883115737969476007047317891603414649493187684433714229351923222622111948988250763567812114440012890521944446324679462038353443156737762803520930394809158737564006933339089003471766848929408236356704808620267526598763550854052354066533142437817161654072463046303731887388510603460537220792242126742904391729908736045882610968412553660893225571538742396520917667381935638995739316994174378145132630811157550369497701457695462511997992681566074574089345187690474613629533651405669980160477253383242090494523518475050367286066201393559201009120647170731352078384261493719745363814131999558067374065788978989942000718800586846113897170272605079367851486874294837143345013723897799814643714871734349204347143626239889745836507857407562070670901511785731662475624546867943154270229560178183624852506237383525659476563117546987605729263331585123679585276023631057555050595459861386403931351258544274182739796349531553243199589237773732166256085057058256864059087341291482853651776071872784366246241930946007056445915149269969418704537320653801530372345421369896450302492101257004164153350515745492772154568532403289806522534383075321916921122683982241154652173311725113868936607965620234720597000666333064813818682886004789647672982614853285274005509194367990092449421188990978214260449487197007023771203004549346735873924789639265058833859833124147490847003808913617277013551404589618113733042108581716657961927517389863529733998901935792738471880117142739637021456207848536929442762059533169360677689387352459162807096012364766932136878010093155077812301461738432827762888436744393989287942727891541361660164194890729263632843284085907805895487860278089343762489352040637541772578038333785221530087074329652361335205595270663259790122647453539418936289525306541248960827382112659669519832845656729444444599443291371120056925401902774619259858412440634969284589187838701816594567275510367527173512500894909365466112550722386811607379456910989769165044634587692105473842518140559940157086373507271196465092662030109242687570113788198519613139351462492168777160622852631688153255667238092917463236619053507964015628683207375602311589777068333608145680530541782813149953913298038478671445848712201364947726549571776236260612436670576394859603695058979769693445384835030090777916168533851904493483102527582961478105055448903958658145671833996155750222911553799069255284246620069303785773871338949077916066769126701979575991793404748088973922479493134391032076089832780507618170448519352842453035577526494243198558904123167303553574141941378440809512438152932005462527601707774772964630886510570578678153287753153553870733403328700105757523635831324062317198879702775315471447325555441126077009244989114801286869942538138777604410796853549026818358654764724103545219680536019727380604463688719896352200380988938939814571110055138123876159744458189761872115888079230765249856033833008247943051229134074294090732212684799408956945863729358265086978663073826904549194971285459137448537478467003326536746206965850482408183211090235805418206567485435025542666779499563628052795414932175210207143270813706868710077760279463296626843593733779473142998343841635028269206120733674393771402188576024060528784925921095621380559602138969892697751199866051182180120604135090030079119000545316173905731418749946724797008106613942742978977090717660358289498903839576266310901430531848401721243873484089846871432488907958454161502159986301677419180725340716528107254716188856969691048355884658369952357971329086494317721686961179225573822808438975205941682552384698956825297124178687000091541433967377888886486238214508732289400935125890830533977234053109608411301271318765043545273734979102219345108858804672374966845262636291301091386693666395302491250638140039075464390307521897358270763131914873187482173970200413099325432519082573540119427133587560971307534239778143229609617038739139597446787736662415497716499028527682921478961692244224327656655848721445533473305798431171849356202023469560836338706650448809703581406468381421297702926791751089099933515295788091833909594985514145603728613616910285522862126459335421903097881466773844375946840921235844213027037759659534324813765411699303608772347859454483680596031636312581233661064435679702832933546972026725278494181891791023168348125508018998565248977249552706709495277785640742138295949088458469758823437250158726581100596479214158798879611988208676211860843907611436231213242212303681414005503097820183677851086858141078180364795412493249554126635834195284291641757364651327037942207116343092724223583748768069498343526950851898245673416628683123504903436104916668704036821919217857110100328196323277798912950960616854302925539617677797902266008807413704406154442282246485088360094642063126166100317655054314390473271540770227464198275612263374961122874255874558740068021385729823993277257070972947998479426394087018433014153857043249613611885917011645651284286575400207055187243231833737586777747503392525326516266658922190550065145629859515805810624278209932583348133442343502679186603552091362220797322064139996510877361459605218774775185313680307701126867824357443770807749679584636351346411981203245369633953244580032227462514616305859974699899600436380335109593465883292046305810896198545257274979856974456651343513397740947603769480501617431216334671453598152272388713471824045082514379183271527318111687169601423996980961147504159846801196461072937375918403346106173586332266887294718037846778613431346947460143497831263720267042414210337888799554454489465882722400748746402210824741503315823396922747151118703602588558693896762633316447818838757994955589209812729799470517833270380367817539274615624158210632300339170801956385953641874759437691321942115554739785116986863422677708884184800247533466493917772210034139512900727503683880456873439246106816122664232709019219706679177283327919206024328387043267095949051759945316118032239676431340445163720368331770489797687972204048303446264795621449320657166636595300258949840570399457087704731229519544934803372994940621136731780208927703338256520659603612383199812685985008314030674326083467870200563359452194030913169879627588369275424916924068065503748228425301422031707112647224258577542187215712745961254077538358204987707197859481521685258515697883358030436675220081756023269464047631772530386355606108706124239422848242620969156238590090184303119587119345266863346449197545450998925535164203673259631056093772195841703424015250765377779330710727960307430417086951410762314061510657790742161604387693086536493692575310625043597986420740835633860534132305779984731425143711543468246993232012757976152417041617175908806196973465086280504126334924828914292211668887144786507083952710904795074566442089184352850637482408939650585478942624376151644806785021698250428151080081199527566049468589022831642765928880190999409975322058905690232260160627911663620023055440992883173285538769123334284138639577572426059945918705713310504314286658446440044889027182144114219696353797696092208881572674675729464565810942745652864734177073060585060012797922806769995983426208427137116940892404507132162933905467636520103936798348889743718437158042484130312955434687767902168483066171062565252578290942710422711588686193380236487576814566231135736551250172938751097154566850391557341464443538964005075468511939931564174972645596682907571967720001599310481577474586781099974305417124520121459417141932255281826427856397306157029587832991575862683611972029050312999332301900594745973228896098463965640441673427386351364307869599922350407784478218797218517866402481794524474815658250815501630445696078646412766309438109840993180918065715053739429062822374917469885583725054589331860217125062341295710040291287109467380802381108416715475091890636548118214447926741693063202594930929803804650436086079246325783517227504841750646548231194818379964784029007485865148625536869369222131339819303607774403096925085419151438289965841632520011638769898136558776199176640714048411046672940195650813208362235482266822638545423275360014762355540864507495904779001944658503643121499025769927081555071552910846064114101184863326249930093772377888198663681772246338608520915523146280286741425874447333373976024318525889801566622747215707789915224319942560371651360601560165102444764376847943769981323984325357077600029549376508877922297366607542314847624110523062197573602100333093032872316840338253210105620142975407770947424301825143510822893892158587390346461439953223391360606405752817380718095018711692261491785724187437855879957765590228709956048515073973110050119879726998338703729567696448726170559737030801219646716402809288747629308384230684991050153371452579271591678208792676453762971772404016667647565570226015267051218144948419341535424225017978528810498379571267563367334329032620028068378989373394835193636507090142975139597242205318849675228187884090168493129087267398378957961125486575663455884349329023673759796812717887569490719986472243899921417540788941084702771358099929566628858223158036711036483923389545792959004722651341598529708718973148927210467825759013412092985884179382224694920886989859430749363668684921539076827756512278572977429559398689115347943947998208213690855357980509426341803799860461210483919239716759642550186958688848867199272664151153095872336867821476196825525221953219385525020670884603726820842379950112722700300574233705567208065139822860468903677228275517684253671874027825687621489522672437307255809759962789914388727017290888270512932488717221904175825944481862143836623301548904829070591354049927559277482685986162355636336169219937719495926221222886456518317076085673173313199168941270642190632936763587368090887279766002099052404748761728026846886413251728761532358568253099486875621991405141590840200389250294174121091056391951846571451440169089463945812985654365981753578142414963485609167170193641423783263429161579914333608903126854309251639301698889829045999616617381456376952180602114163317037332488263859876128257809703568539416691488910862220660199457098192345948504335466885127020854243637317685315434054128584808480500796803774325654237018642804750067397911336350652446981911142897876271872969552404674469238331307332700422256508393465381054131948367644498142627581360631451874577746202027480107163059503419280366043133726914006816913892390047068090586566732296965447566057820371272718468849086953107413429256849871864838357193172109720839221682453932303380808873239054330306439541116379741995312898347844184239563724355043286016274354772554198915416606928269837254227055238106036375920361737103083094750954128827418765449724802567284182503502236231316171308459035646319502674747607556413661636603340413002091123940258210414289577513059007689287818575536463556460000888388845560962170354163723382870182896133535317255073209983726783788166067861856763044294447196513022385313003712998046183718356612567062284116741148386459861114371452779523000619303891875936405928097935492168712790893849902117542251801690674109689921232233074129273596494234432996942834365319812724552572936700863089267811098817341236626181593074163116666520096011150579970747310122263866579867498242393615067697058202837882835662822312256963257547265413471946179195933779157514373840274583265150547471829479723107352473897910901077553315509011999891016672046783195001096042869821128272296741689539102368777699431733168097213360716573366270931306035198094741083492264539821704973406697017841511960134143167331993759786309994690993206231288619070450609111210001758839608694662196561003421896347407252832810225059038887951005201542717087509255065892632936230006236348723359067147153741342375241928087573134084879875398313651487818552072144140645099468666575769838260567634320128773664514135796029884025634602418204234724715867405363688427659780187890163879318173150663971645372326151992847255085632905951" ;;

(** 
atan_05_string_10000
*)

let atan_05_string_10000 = "0.4636476090008061162142562314612144020285370542861202638109330887201978641657417053006002839848878925565298522511908375135058181816250111554715305699441056207193362661648801015325027559879258055168538891674782372865387939180125171994840139558381851150950216333064938721546097320785555572086014632275652426730521804574640086974505838973638964890026486877853780128236331217164578146836900993340528882486244562388119090158949767997197011496776001645006253016812125609335304134939663012931924274840293161119492061620844159372361273166876981687027593189510333973325929038512892545945922463215609783638009537499320948607339491864325160274827930450373317725546504996086757706227544162850222737237119744733669773185106940138112699577792562748256600962116726748115272827225207225972684215710195877562091701557768709866542668903449351805472890053707838124212854794303024367845264669937683808877190412767311593748061628833032028804465239589618924130515270876726439400070443923542442569122697771151892771722644634150145716485890125410264627770819474510187121848206047727398046439957349224139591268151780502232786355143473370794824012515330580015109270674591998921707936339487128099705106434535905756066721321179928796810834788482208814236046748277550051419142228641999149665085114408471992413608401601552781943713430824557974302382508903323803434068518473787865127452243572458152831175900200570333436340722582648575409343821252189315998634896079848398950569509327230867566007767526527325937527348914841568663150066536027905480757904442686045155144481770621729279741408022177582556623823669211341535485547673559698740403651376523360604552361858134487150068560941142804648292599332129615556169392765012713663663644382665370304068180900070642920215430207040940370202416950977564790485154507331486121219635319383389370295967399498377431517045276686632606595496136731808902915694507741376816407054775207276716924038016761555082142572821710117164287897755349658231508880156622408053339948132487758071305256952539999844830904765141014416155974842287025462838604075806043985868784427302290287364942622978670236438745690088172773820112064094821984872431565301002952700559919974848518708503472873112759779770031979217897764986907330345125101116669216324139588798536635805341822084175696893354575455388036580383511343682041749500153202505111448033772165775325072031661204014407896084727322343189713066558880316846285679512491843834326560064346904537201648191961099321721830204311907422096692905523090908076843764546107486075459714572509786488440421541643799606784470840556712506180619618506365091877099579472126873054787004721715502935383264299133267126732148684483590391369016581582033804184405117298726288180810432731015717939425333017643241443592247487042843602324903235112363041579772488623922417763883514778675560239658650510639671223640620580297945204491364952643389491073916771824057250771114156533613977838035211399769204768226566987573749729199562177053021525507639733213995197990054266244157371992592457207880020257275284292055763342144957620010434335776520872439480803372060785685851849975346183686774072059733212495813946343558223267452765870324389077865290206956660856638465078366632876642998556369110914005430088196344755618252938190120543710501790088064980825436512520603747035751514446273836824381510334672352847165286649522293831659318459163024732426152876436372853384306830529759653057275422337559100874000222737025123252661249892144442154109540453237217370226683491769680993935459921404584856755171756868230782609968446581244803202883965297400954634041659598212874560673978987159899423756846287325897661989089738089092921762932219487372852064283744117623075635725125959755272046910986518211440377102662101631470417459282270470012612945118207061609673074395614941746718608524890135214870909079608124844305528355614289270789227192999124295813370197792559416327179515267674576735665143618401294496107533206741977930471966187095609272555049440907352740631120319873560232354666148325091406837020514505482091424440146064759423425160852033281762741592453494648258248492774011793203836520325287641841759931515988480980039852678153139459343829154392409854928064556063770386599830142881050498922366546750423903306578850656668276529259116220621241246775105277666361793631548798408122540308727852083281569640160710205095466387746614410156190032591778269989534392359761196664122091887450981163887320594923677079524840968309537183178331348898408163376639300962433356052042817507667227055265704218613219817896299913998198260411944785984936816410030302684692708408515136054991103375282560796665101846504655984756271177952430645684546521272006661185175834753754892276515138941663062659590918550127813536417962827517005208105358435199833217569531116164195693670513935979746668811622381958820203839538081241165194081516000599052755022961494806119020321884422326108522925463542253795188829471658333876307987618110943589548910372875671134291448294665729230231942630296691659360846751777119951643805871732361168055588926673422665843135832588017916045746196909981345287393010724452894427443267075092794694444961111189049143984740732332752740438810137988643095684071710411089936932684825166225319312304745294334389984185812820012541159597417647461528021695551421674720219205219498950573131359684759315019848962775807491878789973358543394077795824233096001954720657521636608494788846037360144703588134222279262048199063179961579387662491599094518554627652390170384048408923489596483802368815858224617174933536574549930450711131760703570709926613299633154929100559913674677809580065570971179228501027682278845278547634407070416765391879205769327234880450061078412467707659996236647959778467168983605324482742691093334344591749794200265460105080582358734283330825505165767601322148544744993277251626957737569493688357060345164759777778729760592831345057336934446265497703341027890515205894957919687677347098352312988612602859677792338909990549837773576363197582390924811874716439095165796526455417065701280530102851312315610524956426595765894433704493472641244624453707160896783764980923321496053984041193624004151974385777208716354303381379693620639121217962193233055905697651961715385761896455974883021727013842208968074775433010673014539654956778211512456074575639748235610688437120515562007530643511044979371697646071609783393810748203117981798773038065727506901883372356194151597778389432980908843716886394780197123235734118104566724457680462688710580865182271044327344831094291661316792808932790789522184860587588983619354499928888205860408530493822910331109072721753282711827143333587269432888624407932898730967118800994350498596816916868515580909771539862648944508810433379283404868429598505876522787198345246138646964210160597616102767151370327282853444957803052230165623265468184652468459368166313207062333744917283599670656309949127979857797953820151331219451304787043151397622950458066465835271932002794087524492646169198849899750779047477446167714730657133304669076742039607353129382736286723329015632670434997090770067773677277447966770282074069295723433547802165894472240168479234656399938978192893844579887225590612553236902013364735048724525932149741344553865584062559583711223740551284441695207154474866889114007885004762243610478242481496926500400700445177618496803775462326918894160467845930105262130342827737171881023195733709517058877460977779920324690024064603999866018252523823129917165868105825362978837603587546593676661785962499545555374798486923482596794802620061235842196735217358168513919481623107977666022729337376005270850761408150920639091905045012864118595576430206270846355057170155811986517427450734476398257302298197527259946523619819043747186073480501838839702498825424332756767450545451632568064303461594446083797644132502879802969201041588450582057644052473875164877291127200390675400376264623986027610802432212883901440354988886734068817346686094338170772546069875730343723426858022283136447364042082135138782042752133127953728316166069389000487604686223517900007560951161411769521558315483127948428723586348421813558486350482709485122066325638500776955560514037349058293442590191049705559590325149929474389414117148395709836021832990541295182028422594210343879091292276882340550960132065397674535090931809583188395745509768860634766470499563826444177827107914410117257226683735080897358008563256932355866160568311573452024830590356381343215896393694568051110932054256585385019801121532479529464070868137314014884201595714982349338689305444488572550194663542667232995196780352138600944413233672969900039901719599452732691067872101999443486988928892851229050022891841161718496218361633523054087617354125683843716278610144293618242861919440006703066885073994494992405101604622714664970359863360974990501893669318023324732942486632992005987683356230043716951280747218450987823917446261733284551471572381955219076068106492297868178914645693285984616777040682476577499363017319905979946816204845312026150105262579095908849255508987336465917561830600637679198258322868218717375297339517399874043414779818683287530578274095559639212336215574098558082109830159011006073454462326159750187030514020519169186792303838833893397325066116615747614032363725734071110488989052694990039776238323968007708142032970871418623885818032979306311808987132303063428382033008336448155459284035195805074243868852807299050490700720717684452361544215414471605759495594335063756706430730806727243210957901183958363299947384513589053196359649798816910129991118191528258310707144400556618237929646349987619566591870131321350006820347901978727618907290818434462574127340603490043292779150633251609697011639307055455431372831158801959644233907094566312822624280234688678432045030025429127167124027312513170654800865723883606660322906280828959659047124219725714775521069367561958154516091025771345918042096869337860731285523376665145269730303638845329427453215986775576761931518697829177548457999538835717994699761267997843665333961194038137928676173790107036235508075773157415059543453505853491470138711897692519019611823032" ;;

(** 
atan_05_over_pi_string_1024
*)

let atan_05_over_pi_string_1024 = "0.1475836176504332741754010762247405259511345238869178945999223128627114767860263367317142989477898040072817022584128281502051456215212574939498578221745414599940187995417591093279498715591604031349271099342015425615134736832575251590871914549016863000485145065574850699148359419969209978028399094697032037737104216078815005155800904706431139611973261872240857917500891612183003054508020736904639543575260558948426244398071837799927125671333584571034672572223780142296931570408864630359097223609873161914763307938254692325284678045420558563896924262304799933257892929603866259042429298823134246665023844512493698971815322280687865131446724736235815266915020974236700852256818325006223449265838396632861950696262049740082921875528999670879209220161603098397321838146089385342288815877356876363720519379780946756702578438637088625279626151901868156121685247513883495427094551449938717008569289634269763473081177325133045605286863786581698456909441924187969637691419540758225444374125323403758176172251088269388603393288997880015" ;;

(** 
one_minus_six_over_pi_square_string_5000
*)

let one_minus_six_over_pi_square_string_5000 = "0.39207289814597337133672322074163416657384735196652070692634580863496127422658735285274435644626897431826653343088568250991562839408348952558397869101910044168287418837630346090344128142725232280081846950544588945104349233845519860235478013752874888452546923326181835771108778185425297888417868576864617275811561330630424192103992371844063005810729791367810232917738723885386964431826453535905907614449167288215917896721626280528275896067038147627421438102874420209114283031089287791823583188720457836037724958727540937325971240235006933941887088652273182790886585142931926559181988974866244340862951315812052809204750474816430247023973718215153491786148753491003381673460786833208291818530068999090721752421441534903029493841963810349129854816275432069261689883499042672794563279299504180713102088765758949225794484407306891253577533262758052911265557952815325040663628650312916901015777561782819610508727218752638400753963946901892734396711153225803445533941568858632445301649742519165316441371609711531245089243290549824649975134158044128818527386726565538183303018146350709277119694372345677582608647163425438890427150410024157713718860965862131327245429890180475113153411263994036956927450905854836195277537880204828534118620902663388920837997660386215683412323571455281034788094296469957634407205979637839396999291268859280494867831202839632408231414702965284181311318387323905136101845230649191328344204506538210488338362999418725024491290968463024341230939260937210637763357668716325043532540720756824043914962647749839154837035616512309032638541576246512363428759766225539481944983492434326527204170645681513760558107716849614234624284323701601285720556600781803702070830269262536977533958130472783157895527099648524055663579209506965406389148701201411165643257462862545248916282535924283109135878831217758425399659926807364022613100715042102603188631532662678255793368462608650127902461290448248933845382593062932405288099147085163337644259096942457982869681884492751291945213055219225791268428646737404748762908271223988080461936745870026987077963833251743802479327783763199318341165695354688986587709006638984740347519367402758489989916610040443071767511540635748990264849985865097486689959900054636548278168659769020552203441195594619095883719967595163286233850666913354175920848129816950224785210602307170200324097923815543904765622453721166092941083477472617302559945103931826892133402269758301852813673313787284287044516786005234330589325533869618136662526023138681759816054564830823941376406346235393059115570371588897152889961892481410619643955709600104785676501470053957334404492263310332087541957463774082958556187073996705969238130327560015852814044634211981886674723986988897022825327742090060873707979236631087584065217349162647213909628975630351127856180937849171897544173187997735431685164552213725723547887766893999809160919964767617090344204462604438931997737794915491499507617367123976245445662884386972100089268492901081935107944719414842581272481248389212828409389631643367179863342024797779288701814583298838958832929265318994914512229305037934174323166686217001570566648749237816190371530970670094366863915185878559044766538509033560898561258893529669960565355241845298083885988208630792383965443493189702162463545680223954782323399990578055375238166359760380063033268621526458667579176419424938930517625097922755311183710745112135686482997935258127774601766702374701246949854388893425578843578779948388764843816364323561857066550454768564160400372163688443710008619746963248721285450733227692713183294357334410215067068643812289378210321931889489656820466809967506206366896603638875961668977227433190924290041768209356873325152340791912813035141325564405189779991290242963653040502971303969510916052321346803263616347582473895485425915642466980587305549090607684017625337525040913199423035386079297039620191288580069298373556249429733144977260490424072181862404526826817071944122527238086545093279183706840284479537951297285943981771954473076657685349498593661734118944882704643158420248935512451236217550768155753514781095976468804752093019662179762466247347751258878263063530932485519204198416357559668554659240563023943272791577074043369103540249505902292249986184531429207320441603873665542536935000660592213839517613747530936270214955498346033948852217917507874321865944958743538264769258134043919235895761280482175277831086617230368023430246344754243125747354652746626371109702030400946709013790121636923479334262138445002114553966856917269467351180089470344256454746771666622342456492176453740878253161674182945911059921426724376964460732328571172726217308529523262825426126910937230270053544839512546829497880117246462299113726750444859334558341040251310724340825881906883649884796840752694488592880986955465404606887058715891120910975896486172581109538650183092274820509139397244697423368852508154738304143183735570326011149855299682867699250414750565458319892944377315536391971718447000833094110391910495202247093032743184900344414039480499297560832897901104" ;;

(** 
one_over_log_2_string_2000
*)

let one_over_log_2_string_2000 = "1.4426950408889634073599246810018921374266459541529859341354494069311092191811850798855266228935063444969975183096525442555931016871683596427206621582234793362745373698847184936307013876635320155338943189166648376431286154240474784222894979047950915303513385880549688658930969963680361105110756308441454272158283449418919339085777157900441712802468483413745226951823690112390940344599685399061134217228862780291580106300619767624456526059950737532406256558154759381783052397255107248130771562675458075781713301935730061687619373729826758974156238179835671034434897506807055180884865613868329177321829349139684310593454022025186369345262692150955971910022196792243214334244941790714551184993859212216753653113007746327672064612337411082119137944333984805793109128776096702003757589981588518061267880997609562525078410248470569007687680584613278654747820278086594620609107490153248199697305790152723247872987409812541000334486875738223647164945447537067167595899428099818267834901316666335348036789869446887091166604973537292586072129486973545407080983067489383412371863140083597961886597586874525330546892129766415704206212592463136924216805908774083358139286665415849711625870695565785887476996312969525004593726273890268056693551287294338372191311166508810015878626559156379540559056778223681400309688439348086228481847913456331411930238402640972748436449621954492244652220471763586074796585566605340982860985740278837433126885633544343069787018964358261391181002525990207661844329848831847239159127013904570477357648310102119282970853289609316803539196498695732643937914903084854706164337898563482389000045642618556224969309139603125202237673760741538621162455511650864367991293893712255727528553585053886275469281675504073039189843896410520398990210789077410746707154871874459278264803257453294068365525441034657373203151382251293614376241422022507143703697307346094148501086031893236041133111157449377024914688145536097228616724252720888890615174510525315591783162470294301780959342523719751256123" ;;

(** 
one_over_sqrt_2pi_string_1024
*)

let one_over_sqrt_2pi_string_1024 = "0.3989422804014326779399460599343818684758586311649346576659258296706579258993018385012523339073069364303025588626351826855109919545558372429962127306255077063452705827204993175645163458075305972536427320836695934782717029991864190634560328089333886067046536527967168693419547711772120653253753691334787505604240557048842581804823179037728049971763385753639928391403186932836947717548582397750544479277611550704127039696724850473376038148139239013005646760233563055700857007266411000157215639535778231234109526090692690892445672455546721057439289152567351093038506807831835198065519646874381899801659597818877214588616174599005017129609403663132938462018650453099668143164914324210604174552945392822196887997927181061254137016445363676528746484061225977403027576320137094221945117254654707584421414225028380618685941352575547745498015305783491476130220074228920278210933026332765827429434136126433849800579635878944372751711550135458598893937455188943407383204915198296193070717617508033290865473642822691945906753799881712938" ;;

(** 
sum_inv_2_pow_2_pow_n_string_1024
*)

let sum_inv_2_pow_2_pow_n_string_1024 = "0.8164215090218931437080797375305252217033113759205528043412109038430556141945553000604853132483972656175588435482079339324933425313850237034701685918031625016413788195055397211362137019232845234283123411030157746618769850665609087759577356088592708255670961151160325583610145341272809522530266048616482959208524774972541911912715005338340736745131774544166994802155309726843906169721059958065039379297587005270471610028297428995734644505701701103082693052989627667394002099739115390251169211569333185643619328188673562593355209381270166265416453973718012279499214790991212515897719252957621869994522193843748736289511599560877623254242109788803124958233784380433288024048746709656655504995278876718035125534437848269600140181569126839010061255598460311564311288019954667849660214879231535089640098219689014895803216854654610987884309337514753712367825670561755449006966793738994511054309941104496885722712988110571857208358316091748856580744231239564558574037388490440331108074066818018534205109244035940825937632942762395325" ;;

(** 
three_over_pi_square_string_2000
*)

let three_over_pi_square_string_2000 = "0.30396355092701331433163838962918291671307632401673964653682709568251936288670632357362782177686551284086673328455715874504218580295825523720801065449044977915856290581184826954827935928637383859959076524727705527447825383077240069882260993123562555773726538336909082114445610907287351055791065711567691362094219334684787903948003814077968497094635104316094883541130638057306517784086773232047046192775416355892041051639186859735862051966480926186289280948562789895442858484455356104088208405639771081981137520636229531337014379882496533029056455673863408604556707428534036720409005512566877829568524342093973595397624762591784876488013140892423254106925623254498309163269606583395854090734965500454639123789279232548485253079018094825435072591862283965369155058250478663602718360350247909643448955617120525387102757796346554373211233368620973544367221023592337479668185674843541549492111219108590194745636390623680799623018026549053632801644423387098277233029215570683777349175128740417341779314195144234377455378354725087675012432920977935590736306636717230908348490926824645361440152813827161208695676418287280554786424794987921143140569517068934336377285054909762443423294368002981521536274547072581902361231059897585732940689548668305539581001169806892158293838214272359482605952851765021182796397010181080301500354365570359752566084398580183795884292648517357909344340806338047431949077384675404335827897746730894755830818500290637487754354515768487829384530369531394681118321165641837478233729639621587978042518676125080422581482191743845483680729211876743818285620116887230259027508253782836736397914677159243119720946141575192882687857838149199357139721699609098148964584865368731511233020934763608421052236450175737972168210395246517296805425649399294417178371268568727375541858732037858445432060584391120787300170036596317988693449642478948698405684233668660872103315768695674936048769354775875533077308703468533797355950426457418331177870451528771008565159057753624354027393472390387104365" ;;

(** 
artin_string_45
*)

let artin_string_45 = "0.373955813619202288054728054346516415111629249" ;;

(** 
backhouse_string_1300
*)

let backhouse_string_1300 = "1.456074948582689671399595351116543557653178374847131540270702437414001506265389895599645319401860309109925143619634713548607751649131212314292035177012831740536952749988025486923070580852845112405300017929785610674919708500577500543876918006880321598062027363417356048168232439097193791289785500904118200688937417052460552310396812341576525512433129277215785863200546956931581324650004090237066666711754715223656404435139816933897393039370845583083663673954204699781529937479262522509176696565632172665853111826270607454521072864475864423171791159752769796619510053250667937036174936497309635116088714590120134091869499997295120031968556578795771544607201743679313201927708460814258932717175214035066947125582655125313554551262159917543249176870492703106682495517195977360444748853052169420526481382787267915826795681696204296018391884157645364925160048924001119022456784520213184460792280406677102094649900393769792429357907606791495159929443790621403088414368576489094923510995437825265198368484856901011746389918459152703977404667676728971155101327132174546443750334659500522704141595460088607253625511452010911527772409945529661369953185099874977420218534325577131312142335792718381599168175062517619961409557899540252930949162774732670169980728641896675289794974645089663963739786981613361814875" ;;

(** 
bernstein_string_50
*)

let bernstein_string_50 = "0.28016949902386913303643649123067200004248213981236" ;;

(** 
catalan_string_50000
*)

let catalan_string_50000 = "0.91596559417721901505460351493238411077414937428167213426649811962176301977625476947935651292611510624857442261919619957903589880332585905943159473748115840699533202877331946051903872747816408786590902470648415216300022872764094238825995774150881639747025248201156070764488380787337048990086477511322599713434074854075532307685653357680958352602193823239508007206803557610482357339423191498298361899770690364041808621794110191753274314997823397610551224779530324875371878665828082360570225594194818097535097113157126158042427236364398500173828759779765306837009298087388749561089365977194096872684444166804621624339864838916280448281506273022742073884311722182721904722558705319086857354234985394983099191159673884645086151524996242370437451777372351775440708538464401321748392999947572446199754961975870640074748707014909376788730458699798606448749746438720623851371239273630499850353922392878797906336440323547845358519277777872709060830319943013323167124761587097924554791190921262018548039639342434956537596739494354730014385180705051250748861328564129344959502298722983162894816461622573989476231819542006607188142759497559958983637303767533853381354503127681724011814072153468831683568168639327293677586673925839540618033387830687064901433486017298106992179956530958187157911553956036689036990493966753843775810493189955385516262196253316804016273752130120940604538795076053827123197467900882369178615573389124417223833938148120775994298491724397668575632718068808279982979378849432724934657607490543874819526813074437046294635892810276531705076547974494839948959477092788591195848724127866084088554597823812492260505610094584486698958576871611171786662336847409949385541321093755281815525881591502228244454441718609946588151766496078223678970519269711312571375454370124329673057246845015819313016087766215650957554679666786617082347682558133518681937745650014565261704096074688953930234791980600084245562175108423471736387879369577878440933792219894575340961647424554622478788002922914803690711527079554550541478268849818524600581446651786814231541148785540996651673853972761469701690439151149008933307918457465762099677548123138201543601098852721629770108761574781735641636985703553406726493519631695547672115077723159004483382605161163834308651397972251617413853812932480119463625188008403981945539055182104246062921852175602465486019297672397405110395264569242978642124240375189267872960271773378738379978326676208611952067912151263821192523294040692059943864274693215338856671173308271424083326592032607531659280423102309973584003959403426322276880701186819617678090563158159784537637578356373590277164883131028876937950535073208018075810223823080317625043294247222683912297129553513551043147618866554743676921841201887716179922856205635220547032006918086880661211742040609924123487605154068202262559504812485894118735834682290423083615554769477770831940874812491674892900659369616416623436837075439638389451440119556487381342921229820013021079961922424924493051999235858158082603524979985059186697220123164897104830701793528112228966355128317437352393011402792389808744569648309013207877658785362301354280001629055877295006795876178247374871378060042208445346045064702443258085164777173903196028655538328281415915248735263307150513147882844999238663243198106336515243311321463900933362159160744482923457177454817169580181688900175285645046489139090420356029836045652425265797270138586757653899302958449258692189788644388819358114526770563160609737684654083694230203816826392458579107404870879877852426140868715178575801006023681703491797733622196629537718913853116739965565885912164628015582629873541376336076073020045591202946657347571852745311633847776486838248504116301605227086944442703644251242363971814999234960838959168258036164749881042639483890042940550431502193126864230059992926361540649262664186583594904249371523622068403940370108680740098440001512465343535067233845469463576021186762114341424761178341043127306116782248833969915539091310973231066781117485537679027231845076545775699887411395686146631581361573674061881125914620397423401125882131569075175754979658229689846231329257273175338302313533232870056595688534175204573932758183513982347678009261426521074710456668763134325667275929891952548849037809046546488268575204454695053813498309021460489718319387780863409014168285484524248093104343217724788778248739486061800233415225914146138782700545170971410457656614928953108672486080484204376637936230213645817798022720882738071736711299822289069125763027779162651035762577038104288680376054636303337940367377696744757171918712803954370966413877226626889837311111602004518593973174764621542838460162144526553720292552051504941828003032550267579038252786139633572720650890367820176258573636602459644914533528141037251683822090097101943680278336708963314672497329503919259298514966414498521873384370124517467421871213110205726174340134056876555104187866544518902765005382178609412105353899784905982180023067890821606141367018393687028304544346780536499566495053180837980207950365835227622006506786177171095672005629703023553593373869771832835337557262344415664916005762666604199085276789703504193295554568745338842121304879862000928706178007678592735175386523677348535053066125396025536280809350562562821347432394399222442739711562755985244339104126180433506987134104280978456869518977668882650503756167591535473173668135683353168588440266726203196600785194905261819016135540883210564405409027216204498851041761292787884227851835200704439460961571665543448392802592501156306227650740050312351417656526449943042570531502230552233576634208943102385867060630430297719853224212043298619528633162199479803021651170071853216768095061934167286284674753307211005511854225758629292681406381602461376952043278677852351940897487799588262651018857167526448964259516245608164680586662605844328281537669209501700131691093864391470033345906701868799246483109181855848104631118954767258303668922657116990565431759988680286731145873457549777440562265841337924742718870078268554656782290336462515389898481303382848801578806646984480217166949381713998561787717378778712739969834267499971632268327257972572115422822471585175485105077970961560718370771383998265316365376758124751878398350457588311790755545686617395928729558719386219223573876438607017401059359744278581411271395680504961269960048434583896436697014771140329178065084925873008209906179587580402996618292021820696155745628810980223576195163967867626609736795492343789154100185728989816837858427303612448456532426353483148925506480782198270518366562137380923695907752151698346526103237738415089830658136487130918231383360055922540017526278742124582625282370841549068233176525686246245609564332012497970680412465220417099693819728527361263918229564824346904280303582683293573927934144962552827643618433542620664134683156370222632876839087900597166332580664331095881812753248627892980094868158902452714692410818394313034916873369765811519402277339800954019992521514349607341474539039230411990899640390760329165111929551028666741487888146370780055212485563601811272094261309853801454061531585422664625843416142595014823689366366735542832720063760749018108182214340861973911548328544384315811917349722801704172459572971660809528522210471512385830056016372167813179800095725635672059859413601259647770490028817068063068944393809042066274116418284908815132355567686236301149153615835301929518669408266688060717443297219890870195003345427130936321480897947531976335087806006735145801884222411475843568459595642012392746288926431857096931750781433192768351309119874941923765705532160176241226139675957034480490314072757977766284315056551277393854632895972421929264699107855832088971233051922897717260248197053719683239188010267755856584529891014031105506836583574883237481454355676661805833306498942393994388379965296325401019799634146428782283377256296616846911720121828661474404077735591989241075123126002042456108959229931398206017121311234380896737575014319013773810588142008068583268348860835919739558648453632085482935260075146055373154056807915110104867854204502431784812177640696641654466861923921035823089944277756117355726622412507724360772601174557283433060318105899040780191874490094925401279748286924188618885357723618971933738259474905697075534520115315402733311828377976124717015057625706465529679989718223087381422674357748520494951554930115312237349799758257618202831754452121431136790914270888108434238961583657657348848869901897285510569345637556197136235680510433375824604783740671629050969122053094969342273645888616180749732254029065265157374208441696502868219289687780182022916709817519263029166075560544631057607509820784122037469094403481232669125215712433087010353789034900090664329264372577975024182433028437809210844805131449637450450720821172885237993949048626138199252205239306727369305935217637216618890419427844146908993764901848571379429452377041302501047569886854093043365370302936769520956382771770453471932906996474983798241227697609433107940858403105491213134469627575233133732110803099242578856580410400798316619455697015999176218878664471943175469916497415202518064488778879851669666905018069611778953196777655119951365783552962285756790257213860335416088979846955972160571371734597829251501311460097902373072412036354335883448781036365025215337515426356641550685916208348770008127064546983842306741350697392385488411364274333848991803820765123559375590563012417219171980889432932113650166895367035795783718714129279518231967750770527301435566890987728156213938442321621621619714293261707601370746636004397668423210772544037792407419121770198942861545330158425131835182081137819138154235421559608389967085629516895262671993966405734193091489098184941482188411810178142374557350988488825815942045631984223214360317409340713561767809014347986994190579589435555830750700972883787924906533440124683055020087050873645653095557917071622999437962377763190566337687723700887467453957110781672472188004312957875214467796449960511800034246725245859539203204670880889789317541179493224981308995641838295378715037761463626258511238016069358074126973884404030409739084583137914246290915648409556851262693103058511292005846401659476028476552408610605191022645863054054032634791028174912277615366809620188627833142120644805591428083298734118414360771660608731081949848484492815147685896339154809451338055599975013469167678833652319853053583863333532935249293050310083172054433905050376413930794611946777014640762590492778084651343952309552492153717435229293942988546906689089111158690716054868384732500504471076651958754718458234785732434368548833783871995617076483652381581775882106687691199738438887994684127831197614230187333481444190086170200582604207251386376554624596299270296087829284515227536076813961039567082881468033399263849883851517369906170600666320063069982547852342755408169692580300982931288816845379325227504659787688963309573341060164659585398436920742751496110274307126469676151836937086582026277051209542930439143547965918260728897001187517345029606509198500136933628468394612030247503897543589083078612913460889836406485044857015659677762794641541803525734051363485532129950844092689612310940754182744027351269370218532477846540339600306219998878318039319704292122495067614229002210715292351093485086757190433390511894693203488114952940303089160914952098133026717570241776747702048465647977984387889350893780320701044377856974402417553704657109846759091830221597568486217210138708825254328906985144629218157238053861792363563698358706440809632911658563595614359386346282238196122201356546966739288220771888508306195019156452016298554213864386433761993145383651868918258176647027062375367382370897020672107900679360185682046291587722285956060402209937565687974455240910912732822595108597224444778399281565562088534838269442581400691380247361462202060899736983794449529070119917881219370470809089734189712410315397023063331178349119734076268473989110612392614402045318979278204807618498097421856104194597221642281896519731426902105335385078269228032681905896448698926177536581470865895031857067258439249126646921556595921463358417125127078556409733127792330834411800917211931482603316472440285309531133416801362768340380656843956224901064370494908671162370101323936333540331303482946612442291832250784904113459290936037071391403701640573451435989843391250388711698186658623254071786832421840463850524922402294215252122219746627890892242630352467165376788333616161489703724438114898481157046067438588570956522791783226579688826613323267290015053503821071620540860875544294715041219333078364405375830493287051435015130482451945497585034935205259578117234780294001846247692094598694846960880926178711735163206818028819896261746322160291576336869342567715495799463074610405499304632691317449812255036823267710191234996107792483648674459526675230581370250480362465582246628910898031100355785864480880974065849602998145682158416712262174948833437240976047910724363838702614759709497782154721992961544399335529828152307598090888043036003879566321290037402080486911085378912885547831326375799173473825279867518797825294506726570553248628326265671959763322223727101073434792672964156546247735482954780949636804529498374256495295751180048643190939852632732319051479912514631474488773002204989667095501472083994719960636635875356737862996568695026670954696168431842247284545920244602392896107022827103035172738727688234842665225206644088771292841615804886744133343251154037199885483639749144086796114104752654810592239140281719729298030588717934532522003225017422123424499627259789994079535389206504191411359720721803071810804828658481244097035637611762987368821708516809351849207641693156131384051153249286540942623014541601333466224647952172780652175063512270382989521794534652994453209532643110873190584673587833562428457902818905325423670980697735617904021722332265296608533456708737489454764732592286378040464543812334110833044112313886605097457586451390038632625853675631677303165726066164971471045067086318102875035208373241249420925145863198760299645845391231563618501170074844874842829825222624397182151173215342804107184187974937499985389146312927062586396363808604706577343407074173237281399459278759773292381069105426202092090017623743082240629560919253171645226238046142833198930030378864216946422876391023458494195850399013687152825184022701277950490077032067972245576726494718932952075176404206425327778659538762171514621960214546086626810163732584419529776054271644916927322804715192822149159563750219496725891245630251662137729008831063889719577318471276609670576831516940848707527663026427136687964704635676134598479176542522578221100923099544722575192307068631241750671481895947389345079039763438500491986214881356697466172437262103708610949660153920575627883088430812631657873324279779021954921514023668810641852019737002261344485354433767019881198593723742825257717612088862905972995714528259794444345278631918691855992347139345792525814782111551008070114520288591962778668286799253672323017857780570051276153966878614481988996436475683377592289986040495779206342202484831261285713483876164490122176195841856656511155230709621720979670720461570744116891683989474248051336261022394412037740459546819934919544947711982173852904788572628732840127540859220601520427534808856690645381336067422487925263856375601154215213408721833481761715874307589068235823510134327030137170155496887866539602187975257704492678601117789876720200097787383699742197019518713705027503199230369743860774349865960858925384896499959607029009055428471410589551467154779273315212485648911571787227374590414712195315294446632232035605558737756625213846765330501807117669929053137742070952382617334181862731566041322258032397827978329610482529169611577432037579163796404635709757917196640060946909140077500849607829187532921089007544229799088223799242189625906431396534002886687284888385516959706454562877126972675373896158863230407543339416313845440066845416518082188833668970336142290974282435560555786773274815374657174078164039163184394768495919702442094996275646063217029545706132900852860132498369952292361831145643469409708451089623547805748399929858678225400628876632880486754223541844390405303995076434928497123348376359779279588287274702380527623618350690981823114305192278639501075089361713244560009688379588693464215682490648449128932106915392161188059016802124055837807361892792848509090087139995492422330086779797029557548254582650748704538807681700027235815227777187744610078008005681922549531632232364957656829884723952152282383196940749144923498368863633899700135858848890321792792843510119244981606396622859428093716216179397073596629990042675669829500947635254185491168761918744907552602130070096115629703210306879997810294365679101393266363354311282840552810079586584119761904239883736720726175484082860097207573606012948844803614028655777522958925805418772793007043124612956663699521186635958949075208277649299939934608517739459803010449436146201743761453083076488017286650424462858361949422217496367337622242243039777886035169280577628070400702868841349031007143252120126499090811527397048552564096859704238829317489522921958806636864183121885065409789898960713932002140968117844343650682552354545065582311056067566983675278925161362206482131534555739670668802224958214283585091057114840045089214440326647438492613796148614536758167945969362737631199565326351704510043392228494826734911792082137745490554124530176884798501689778977291710660787098328146947831255829960153956423007879788184894784024162808468788066884733048214486524877732314756996803153236229106526097050805326987653820445373610053261235810666365477154897647273051668198131384366944245848103944662129762769786601855298401659189970079032133205093509387991696140762083145819638669222005784388969377148100504887807669944908949649200731617820644920289386802777417536594959968985756722695396958441323760095046871993349718054847569403682982495680355776974552510816871207299349477905840558610094384426055494596443757203937970166469088896672171082428054204561695792660263046961334241195099158741342167641916823618151721800916386647813101933390325266788467247343409076050429332326678398250009202030723798075632689068928995766258120083267416391488349942663027880629820074902491743541108840159537935577452808322782431320181569682668326045229932540798274082280236106493448252601672114215207412198466894550411580581095385927328847716454901989405373777732214742459958976451867583786929110720544376968440047274519609830320319454155418822265657311995190181963200654131096219592562474012208706325238283748814560092340146290980231000153641270193250746927006953642201883072782925096198147285469500291118232704169472852305398522879898358611903680853294108726555095000098382545160028798679517882244213037763436248564903045544606482217990443398021967090050535331685807810455964180403631646716682533587738514099100799841463636623832623798438981634534721854293792436913886717623157534221268686589410661390605319281629353438820667788840968644044115465375548916209753984638321421332400529112532394644604722928313156815174202369877498095240805015411008360994993123537799943236862611142070758226320852115215283086959391959286957520048656447899901041677195403288427606747303662292777152724739500283802658378868989088766918529174998275752938322794578876201210132756393638103726981793697231393707526312345648135283580643768061100979875102128475021949092737452460415580986971650998918284105544674939395496160016830695695274784901890735370358622923063354871841988100724816393260344114116868694257576055754530889843229196304829312399026141189698439294191977930409416541984481817058953818522851936673013086829405889187982168273948239106832931090692023415389622399780718066235821788770335677194453040498249676213897374516379875945631257152314864776866476953319652531266494910994911563945825468502300596803942301164483294374292214780881796604549842817983982160074059890038846661847978382612198790465523587286271674189191713790876153035557090624636395105979728991992681627648827249215846327323015484322799842592616855364308960252547029730310840455016304711286277599496176569547149368064994774883007372853659983634412565708882862576181822219299507481783869310862228748677558916376478323088172027724073168611455235157658514729001298731429502276219971188618638083953531312744289024611847495875320544380718539137517188569599188150936351922318408404422472331920169880959608418291907986881298181602289494962341232317306985822866380270206173160551040595167685958643600032281814482058717708658207732249544432422388838622071287946513026873334693822886472807485614747700882632930719330572247017399994948552926714063630750540591863174186039032728990957828948282423111956066955573796233950124452271928435165269971607476957092112093613917838015152980352241540441040648909188179866510568691639649139667727266634141667647912076749531286257899139198686408615564369937580488114202272734363732456956052806729440170919812021322410430356336128077568023126546516868465192242887798687220537455503800027427991305412431729225438875839858526467976329775063885572870445495584471769522159054226503094437198590713458900081205086464760107785538257083674187530176249264127435887899362663693148082506367418013694765085142266537649535223182009716735331250768782791220363578713300900992391233529484208519400788434178596990506984827315922021055529861965024189482323637297270373335723942610446272347738758848746953782099799630782524288733273760371626306042942545004460327667872474760759843427424212660082682743724607374049925753740248635103153598300001058819807784516073619721513525470960752041640752107567985308434221704041588569398515046559591495796252948533311227610489155065046575586425787788963731499559726647967826666897010983303827023148663182812597065153299700903953658191973845943154755116984195156844298072261347164254988473147613699389753101650491472109873156881031060178632045599216628005081932392871812705608637401677502610702293728527257316924151463133972719882233994255776808714551517882460474832366726986591016391974951455800287998631584471910345823732287899712654691877716912889905406655995379885112652859645177499650124281523481785011887221687608529999688738964730810790136848754318217922985875807979409116854880230753413010856277874617065057705268467486892473036452215595077804811097663862050713010200448828627614994075987909497309356303766908538741329481097989706920315603886955349761445121399792361222994958743253189592526859218787816032272850397628136338704318109238783838852877262324202331797073888495793957519569277179895535853853672281644878937707771006009843298558363506781107615402037618538114203568834885764346129304567211422606055340221823014074876701058739066494655347264779091647627969747336732611113921089353661686748221653720025298865086896566291535996167397456855012309093252068463437475160950622227295846296254883573230981747719508172615566261132698250554511674424246488873286730467197902668687538308613533670412627949120768891726702098374270098851937068786260965415599792496104103858299579403601361830937998086010368373590650172912332458821490019463981552951599540414650333499350553189156713889047888770606289760771685177311354646563283341793553834134410082612786056166886356649168377323610760569276531776185302889633191759549336054363536989398512924377726514967078812775292279931309084700404218700891471754339001065516079299932167464009488204288672622556430727214246494810776047829506874758493278936374220265605264716897647843703430805192683347618056635065468722215950979120953475916733903514266915280744170238985042662844188115427493476446200453966134618113152384599661938278745602198813825141234003861715000457474379911933646058342197227778605323828615016951200447742498731377584750318319198002993457497541915784056477248278947771211020752439206419997831617333373256200887159928232087771273315585204992637609072473745173006643985968060213584358283071895307080827638625540044220479097308967909678353645387778467289838441377020689588982981674163429653938868760556011939364222719005736877931065400119527451742088176116152995141257263048172829663856856635636739793561274742905903324550338432608668111924283293118886853526586553057316211052322689598383731369229143740087954605690950585818180025837323865021122274850521097655993136592990508106103605434637758675996050945457428806055181268636606039385389722302562845160295113795207828325197919268482149547905582682953028921987187723474891120518175666000402184013766506129265394198320724469256075226689874967034632533500658413722855923295820810862328466799407933609955568926805933718617364067621783127051294006453669706247177544104458444525626350917494633792341208899705424617544307916293577354078364046154824449906316939756276202904212749820653413756748647563164951336229573957501150960956917134569693845248654484214918203963933376883278866013127333224439427773504343323400281649823707724271409155385757312763689757692641751458196399455653851564517514140376213274190180755104367929769203986023519959365928744042110473021780846083031298484853175211836088274342217859967429095793926010273795994153193159917612386548296463116278652274822494997768245571795554256150928946576597696551757236737421457140620078890541408784544260082899513849588144932011479703875743389846080079894083853695515631622706682538655004425212369338839759483217737768600867027083248256761193110043885198379835419820659761639714792002522164547584032656508906833957660644981261747449235462807397629748294389921608238687778738526862881756493617067018404275186916283956847922331159595695194465487439529244447804405865830788125095610110226309373006924196094483167558220393574935743767376498685652516581924264056599068166032105777585856351350799569318750227835269650951857572322839225021320760031054359676385013274009638785289261892990612364608381629951484516545911985582412883998769156590813664008814023343162101317498732398061872442022810753327818378620956235986099513892259203275876750827257159037262354681439939689163132435524039188879648593076075848885614701967169381540149511697372752517444516562689033182063760211942984033322852526174527240680898751064963132075315370483240708356278166799033274686796492287566694955842135473063665135197854545004082407349124761088595180916432465959887759263335743977913115663148400547187099363646262106821430064928937324201181286100002105374912616155031961412345063645941802595926742493442920909222736565556230238234706230511104796734189761914326914887707938733203453229526519827417925466086594667030140763659454046597584966223993113399718262625025946091007232123806818134756723000348046776374726954413809296859468465632491039819491217940871892994653991539926134269327359677632020123410110344780507679797247667411918181815497319630038768293649893566179071245520103284467384981999997116994650340126607373515642089693641448574935539672428849172483996958743220679749660727002618944142647660188419901100434643740506767690243716952269588141443581312064509622534565917991569636497811463032374322795211547871587941255518550587323393314918949198366729812002297159855040764517901467926272144574587295391436663616910969670328956167617448220672748738672427279517781233370516089885929694929244449742283039927647682875973575810562804289331332505247093325982791228024862970706294381649958799923735842177422239380822719127958012068250698072804526226926655139110539340090929905579070560432152921842501512931874123656996375006443324772428841243049893510324708789327283658126504566258695060304266599250754223024812442169650945712987881272951763279240540288963591828640022776571030115042781356293240015700207538981395325444515866179204612013530946393928270585979205963305172803654924094677427755899864718071881293337269553960901050115487089817765820512022821411563667487136012382608587645301063564709314804688581597689719702223047255672003461673999505538471774317867416599648687864400548552791445741554098576440407075510828815239221568573697715490086357080631225050919662898605474693931848248119749875644105651063636998726471855244095539623728116411957802443269046687846944565367467582779392467358987985283074719956494545269441530803585649035002152979425264395959639891949216059973525821326308090971333798882135182256020906264445303030814896893872473013339459072078096772479411649039902819311515628497029100941364118912852913067569109714569152107789092414331771415294064543293643159480299313467290184301390344454709741355211194299878527163014534223852136818966445413435346274440792084517806009894004856839665852822773832241141158523454632425591755697655241657648394067083861779409771033661017620957244851366697436198174929304095124596333635116787588648444995857690317460733312380405026216415220720209185762386130248200634695858829692415182257216645604795773727197034836233570832908452137304300338945968773683386780976963706185458629263472491705058416712283876553306989180426849323853606600684023663288096269181912903668938658268778004032830190301904436440667615584348775863075102165728390784604393216589041686197943838347609769129542128179389356385009726461604747616844791203589236931388753287614359213805616876245245776980372410014315857979747063047413361914024296285966594977667529431661489203332992713144440506861717009818236867237090236950897186144914998991028617357833505967980565770723134452410156379005188860349238831842070897161052218343221813545840807843150720950611655378336668907154591791174896992962321986545919841148453627792638293879576762359442669069425576495689934577726834380909163467969274084562251125324661947422469816337589912302351299456949985585467164438940122457838046620014849895768928296068583810862449915131786533461842546595855779978085624468600015715829893667902142157680183594175607548826967101808612488413028785250305864418344066801835187932130638591771247065557249339220056524474359296652694334156923220115649639063037052828266971047312599183470481859226887702297996288158001295929117777352167442823841993092071910461724774376275592370454224800671179729888277239226969446555153750915351364995802574117805532174338064464234284208846441723814827554468345330085181155847624461679212943011519608188039593038250367329432139476830929470925529254103100866804655963684250937366621574709987559596204844204028107259959775032867458755248104558477860402697144173502728136309719615694242178388489177541424648012377311139104497478180917517717350270676770505726235157877435229368713495307278162342588957581152862930302379543355844237983987636848635960281083279977182017297207454837456735444046629803246575054878732368441082194049890944136933312055392249387059869784320475965194858300187071121409278554210130709586609760475258635421392340839477839442107671343519490687553690712839340959348674785837089914394578775276221959814018145497650903526553358965623908546754298140807447124396500550860759208206486581563381509445662705526809630029133453215368375040853622463805850920218105680835015050350462084504981871540051014808666273244694251604857188334494480457041254664799294731154738765105464291457438886340564382458768672687174121207599307997664718921599869873086015389070019375420254421939999279905759794891878147267043152961316959097525821051978551267522996983645425294634620349650727067361575285326962677792830876378021149526647529174451366309859783322270189277811327182728378074782689984203106372783131551727759639018152898656756587906208924815638105665502862233026458546014393042464208297022586620146263317077085346405259169086385056622755889182881249569958010723313244588241037384967512227529534963593232353820937438209167999023793841543728755926020882094770334745183311114473193120656603864036065939897904856763305922278828394405208171281242948288336552446581774821123238185892665684075792071133697934505212648076065263900856661120476258156553695611471174583906735218359700587066847742669689400146433985886004078222228654633497772104925619824553470843726893952599864605354604550624648667820024243649427480128906069218790693007840130972660574762086252746370289433191418505442698949724720074619086520872081059597903632958106183770969226211468762922596218892835162473753352545136868244570895740250550853526026733395844123115717678917079605615447634406744446172196838637308545403167549097899648694599992678520357325234849191133459748031997160896178555979012625671465947559218897452220419473449230199587793194555555429903566713088943777713686619188585980970478582359024081855649194813872367907130331794180776540116118755688816607427763191187722600438033994973981713619514502939440012152756749951223082384671878781234465956379634307196186520132465549083963213266877996291794292368065670906181908866410819472280274312584726750950098207209545227790851572904296003480790077941969860602893598122753469496825194492660091276454976521103416939210544828739603413106240017138012247921770578214381629499507736024881520933301434875178216752038428374228296103618401059452375982040345158275883106888213051852565521801616616498572007052198568375250909031168508435098247703502438010677593424535477917494140071308413747684577092849409963748701026231172240371963772882647117531040770139034724231157754785286901497065784137084434430265996610458420816524352799622950409099842268672367272256975295602304949565461758131959302642899954446000349436152505581029319389803424201423309625789231655927013419247123893026590493421713596629797036418630400603585649983448355652605110089166692878737116011114876667601453364357692418467697518184966113493204631732808565726707896936922354972015179131881296026666681832068410156717462252051231359871320101084998996211988192119257079648348991220590585863304311143042963099324494427518708624002930860588780310005159396896046247355228120959394774076266372325260353019180196271213246607358128243765521851853950583166003227603914564373351958467346011255404382487665114366137013647815498255894738349104958817704248761818934648050518264383091671828872082042622770233356023223427035591413419324264347557709313454940085110314520880176756645858606487750716722231357473394270332707496354010089227692436876379929659219247170451013425286745479135846877510706582254073796784756636984589480779158298398254690618571421247479067459884086714149237664742787465111731572636470987446898054132407177564890158105495875963685695963852979876422033342606803203491937840009825466908847672766871387158164525161596548003578534665214698592372842113728432275635918140070604782074117368530966604119951318837879744680091536112900598637347222649270483315454859827447392500164971975592912578451517736229684545166525219788984386670229777377293187895618805913016874630779109813953541825218228420675532394427159194863078497703003811904886601618669635434762930346396905899265031860858983758086257586922468984529015776779119838942550582907171802601671469858684355891815822728497894293660674334849811253318614816871112703009123731746265614280034637596476398084311417661551349309310816930169264797959301877084177391310893849127948511582298584736378132221893792436311583887386025292968276213293246363914432191469001577203635781603837841898786243936283109395199017224693361705140393035591588222555111544075223346134825222776183638165011815501942247356712204027337340396081472646739480157406406106281844362517227537683500971748308458045373718724709794018782396762939679736626169376628188805507329001478462713848888150202990854989779911289740673482971146211315127948101982223083783415747984659961492167252144239762072888282225995183554274271472646942132316449160092270462365279175993088937328493953680299419210534596095541915413004827916520341203821507326529664515131676922128761456931167507148789753886657718174248145003455248035598053409465137356368846067112151240547477117060047567389642878187729481258498193704352582950717758914305191176277789287451694288397919367387944654862317158862566004606035656667437696707745876186999790822816887128780840808003528070899004842726103178514211798076450962632420721196867995817252872657091313818570424829520110957843853952258615487062963903342788925472065503843889459002696076340980765179958799864140593292634854311769430662895424534735801633777460453614466443803311895306851035257980956969966977888247491572703557261886357079565465522499591723942686859534240035292262285728601560600007992623003711578773818407825873202481237840454869863035801635582414699983481899946914263235501140476049538946274903517910407899305050242713781988763240849045336325276065261024947015370470572319767541179385797576345171333978068535869426414140163785307512296531322466009901708185461634054221468681139886431356370278983003922697733531205056849175466125618970001117943956720733588590644346961978011277511334339120354164480743959541661289654422309439645076631678958695468198393930037218264127641970196548095905645585985303403690357216056231919993660917123070886818847926777405322242804806709587021352009150343552200963546433899739280909764356108057918616941573698554610991087047805102069557797218725789704696872640920583328977484674495085328713159385498763564424466450084913302673200254023676177020996865253539873445547057104180109496295555238821697452871215913030424275162741980166087118297088586021569225067982508203840239752018838751077630662135109476272325069842161466776479021502093436116232087903562338031179695505903392034267059619378085488389711108603483526168940702776389300139890997545028569701065369546179559316046845424140447818857563623811363117942335729353056803396099264993518226271622820465534066310041975503631586236709856988271151513042564545052867170319856433631313076854415941227963364076248994175109191881857664887603755572408442355664374662256878667470468971747352796908142734004839461795994769652934515161791764695426483739142094922518918126184114996972562520548373880670953221358302617724503714903419335223389139280239669335589261290043091354004911725766533004845387760628375698008156357781728225924657266939581869052641508745483541023230040095663160930250391829905892450499875903233932066298529379954194570848819915267121122440320574212362965131712697100516225702366969820061322322310212501684197976242470085637396954937842208372554940519028972896701196948837406381535801068706992582507416363305565323781005041555944318351280011533651823810207539229486581530193233937917503247073353659241786160597312374287970726438892107551835056055185307356488101586773431533353059502650607476368877980878659432524610229371720561220697303829301274641268027265654519684405650482414201956060675521996050445049169268806251370393281040212246499957642965758207267062168501874656993745311172013630242836454052610452894296045891323489716108174460691773756124795995685121420469354989413701730634590059579483936744503573111029918952745789306494249422690026373548589988935592571072686146500363585492932796293802104496336049960008004054600493389235526867176429211006607050661867523901141868503555402765142567677227089214888895537104484012434060560476844454172144471092939453365412239191488625316467094306521537817467054690660488704266784595216243798324014835987375724155805634481896020393322048990380411205497246329299975535703323651972000566246162905447960704837754040086227657751902436144052077743591948366771172584005110406025023635255518277799986470269991586566048374472304296110564018628307883121866269686529469126749767151061898082647254252890060244783238542727750482005523983769632783745380410409498174344813065746641429988889222440507065339682551361738808076754529352511559402201950654661613978620557435178677570086906013851788257451103662792658445614711171967614756686006014708137568789247359501153737124377998734018591088979554200177521635893278798842747129799827114326743227206212042998196319258884678372143767870044968609045634164389330905241258447791215909409636975852203115912081164554952936959557174993624435186081342898711658726065657355130258761078480485346824076308537316486525226342977466575040251685973806422233610108327376312839123911296211624876745750043681561410114840219767598673414835481121159866460649305894703341032377185913072954756169477957051302649029939530767779654302885617248444675901060835964664432896732809088247620832572873783665581189091298647409158223975038017690010790576368558353012809782078073326501528248875538780181875109807694963650005953409946676524463486326713878700944897277794019853847679647596245780604581683416291942089216790945612183164441974668668389332689513944746775369688300803697711608288301427500526115818935424999165044542914328334442862270403985939524243806016746764574010158622168460886279433419920945239046900599413909533405027495954510076934282921440746827338338240764297446425786768886423804095030421619784176734931959500644424604647722834275845014642072225788177979083497328299849236899806824308550967142538197871678058726768029003383119949105884698680257972873775466412884957921961344262063392963957552624853898376030044713299434005831873957541845950107794527712167297003974351818687998263303879775007369456609203560175910992123600837279272110452315986621355920338042712194531138766190595195218889761013010921033805735286910666797755601784733226293241319433303653886944816609476159684106506047484138455026551250639994934974968266166441066551802139031058950942596932934888181984665813528399014893630327104886103027153448352583690071146754785633122509245092346847461306563238553435988563869996601567186058612474588988257925983049463313311362425041150367526605943976465359264532327633223319860751018547634193129972821972812936917765373540523212220572346832475001299207035100665762384727402360384697885995722525908452266062691863282211458075828199250172308507115002122057643943620707427834155896022955746495351914508567512874929794056708656539849871744412488817334535608559370237478935102349426821653449679328500582218159689050573591689721439132211505274663264207286280411226782559084572351779478669479383479157704906403912293550330704112102924516835910335986520232091882997202408484458254568473159485768244652855633966093047981447838235749952390643296960640427594595079815050322109469784243288068591108941898937896157550820516744316407054439807581169313640269129171642991630385965316300822806706949491156026615212738584517369434059484144775903620822556479341552719416868004921836995551781485477483975205304202788655061495348481057278030041416983749059686164017934133669334073734527178444912947843844310462935739939040902980148998649493484704163930702722474652200796312165756044622687359632494487164209199768090613711885941521436660552698591646263533244455996626272840802559242054257589343986404452836081389978002591330301930935822517563467904835451068538604861286693116602588843283003985569850855644133262542316362913236285471166779905984501926940735617488269912585186782940707967751150931013151606826822434837858579588080699722769925602037462882249678118817608764564913781718121890224717594255690193502795232086999862955596579902791443423675876662298314474457760598273183265393271754842407551406155089120484275930345732618374685191590684516417544141463803609413979685388345041685892464127168632344682258918568629454602204920565917797131358285154200441964635331344205736343107130843155119302950777358076785333838806043196777195504876131349890900191839285347806420781619856089677472601439174996470335774115534142316125620869833514415443255666118206765463782722520773025214000381086330594392760644961501035515195682940796852615119190973114314917635464466963432290898209231476931916894038051233876504421677622559098506844870085773819681939574597939166891187752003975484894753853984731539026977101786567209028067996274932072141402973814580750409956165906615444836653859373403172313481336554123086773063182166745969842431477634140714093274019482690564864909354783091966881846894497861616837624118800499595576365339220832942263909490543421202423024269128152029970981965109215448889818066900033607371471091484162408323949021267341285654658027260921634828085880748855012536477024921745418397124187124108421569669597589748265135350443798203083965759997554814365041805360513120861800406348121131180290885645073485818852991283396147525216402164179558486194788414415783743067748760119420846998469217666130660970854460378980962705892479414613607001351406000098067552937395225099086837806617648871141489685093851014973462906463980638735536838024822961970953107678125915303701582241021323554465039653412311688557103292746579314045489850780760512896217951120032656796562348385200700994523791869572917160992023842683603310877353834324297886707684630403325940847966101796013645441455749556065367619782569899289462263894274594610021451010623547744567867548842470976943316566036594785131062843208112125111647545970759513170677192499928085724418678673056455911049190697560267009707943927062464783913772586246445549797402750511581692295416671886194831700328217545033892173871635914930862586695047048097266047816143287250174729268836963059122765954692725163394231704179065872375528280600114914144140325473525153569834996837500424912583198617305817914463408643646517014384505600146198789577900341058993958911473311427734011816276991607356658068837502801835671154187418527402547729677386094377127429155823968421254103189433944699588705962289843198226883721319870786721562042419048560799358298042900208606457935791525970125373231053163710610926563166168503587571334680640307679940444060789784545099150587498693813358098925574155766622168159445990260477765693393931216548249783317133410958497891874254877830512545721745065724343551881594387753854615182429238590268973411229929684411961965320468358857634687757780554977983897659194982931496779168443842634362136985362802597385703491909556038231399171757910567010882026918478509552358527575926894117897413809526891406292117233997044116162427192030976316146645584489560353375212279875372829341702420706905059232617908642659322837905012854473317758315343848132091117419463412138432286513401793430140727156818872732284255364226988614696519353160648231191689157480230735467460101311459723706346551419057523081807153666054778103118230543782434755626986526098929094483275413545332730921866673059920770211873754030210312471250231435904167477397929347169697503355720613802110189216451282476075054123773831714851634463699647740038350278884404155447604325320758536225050527508806761345940926740697502047932552889701113035082680958516000417523028203574885929493253893036111848604561009477357170470800040901672145007440527035872960845507272144648558151349878080608213521297937327044332259010629049066537039666180672782406562030489978637783122304282099018084037969543771874184021716194587044640102262733599818158593365452326877598181927503979385709516221261073350423776989468372171875788041055260048494601649203545440874627538520732293270370348086757836354731318063340788128602694851019869015427702324096815909854656618366149329189232805312897454049507998283066461027269467832369111443082564184517213405909467946847373074046195707787671207246870191107888630055547642081880771811961841198339685742526988316544528516443706474360152793492435649325764903595724384550659996092411284327238971798826825420250457224063981923009556383103882365498074891808266246695708504307674001778446545911933427991389597296710703161405895417906583737939519497303263305349199089276731952401302438767455163591284266158875763373008347740269358406294860128411305206532833977935893610781186355145975692621671550684936292327964473984063457314475231823708556136851652853747956348776151214230958523750381025030952742157322061462083953085032140689572374844879111418175913457973488676586418509863128339777194791902745154120250992525875815799668273496844816356224868028778736605417341699916376566538581095634919642246410021617453036166646767784493191687688037604342455682325406325888890510255125872387020094507459965682207682022372401240208209428136831620711042665728552343755203994535506870498582151881444798946681763590435724767487387031313867273666423769572620346130517620869612270834356271293322754244814441539762720328603234137383411832281787718959075612047446860928844366507065326401405937431561702125012152897829458463913919521671255415911203662617446988989738953558976129096935643101760553413097616200778317663793839172991822217771699855527631876415362159050295660065405609429126673910583258757789975918507663262661937192596555297915514056319132096459039262421449491795986762741875170656564452685195881296548342882035648409991274621458114987659408744652471538986596487203211007939581684178653887617750304241325568183764362430899022510058918663252868040989769526515207654193805642961777503783842477034169745357141688754466614766850847279648458465706227774334151119299751212043310405492298062443061970780124885833964010844208954972678536603328348370824846333642251242034255438554747923490542487369732412155062977695049576940322598840527323833838700773547494206625292385568754759528367361896950503254975105475685582904264280288223133583017113458619750197844202320417857560471058859095762346770565043077877585358715489938500855188951167005590631464963846456224224185199851310612230676179904894428488317825175065443465384251332713002302404383062472621983061047601858907494381215097083764992948968483123978975240059120343706965306631739923470616819681720263900462328085534076013964292364420123047678226703833623258852546762685363678261507534053159337313071457898910856926960637345974288402225005290155209988840428093453917218475809170375130608136420984855729076695828421855736099971976403540497075703445820150158257028881134452044496425524101031249676626355293181434949379326010482772434184706399428953446222200412993451422074481419033378931555068522756309684544363912187670081612847742123338998836148123820790426352672021614274850622618875836948419117247948330004158287340051234018949209028767417865440211256360975020769150161031730685245191308694915945691392796245928108995407625899546354852238544875799414709306507726768451250588734995781768905528225674785956202175853620241580733897536259435693193627514202350752121696191367212237935483432189757522193749511566098362743671674688760399745687626778025082784567540835581457350675069310164155301861754793662772940834922234871893773711933435647383144721809411353838943428834690549484721567494897166357418853498986877125372894967217015374967204028920" ;;

(** 
champernowne_string_2889
*)

let champernowne_string_2889 = "0.123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999" ;;

(** 
copeland_erdos_string_1024
*)

let copeland_erdos_string_1024 = "0.2357111317192329313741434753596167717379838997101103107109113127131137139149151157163167173179181191193197199211223227229233239241251257263269271277281283293307311313317331337347349353359367373379383389397401409419421431433439443449457461463467479487491499503509521523541547557563569571577587593599601607613617619631641643647653659661673677683691701709719727733739743751757761769773787797809811821823827829839853857859863877881883887907911919929937941947953967971977983991997100910131019102110311033103910491051106110631069108710911093109711031109111711231129115111531163117111811187119312011213121712231229123112371249125912771279128312891291129713011303130713191321132713611367137313811399140914231427142914331439144714511453145914711481148314871489149314991511152315311543154915531559156715711579158315971601160716091613161916211627163716571663166716691693169716991709172117231733174117471753175917771783178717891801181118231831184718611867187118731877187918891901190719131931193319491951197319791987199319971999200320112" ;;

(** 
cos_1_string_15000
*)

let cos_1_string_15000 = "0.5403023058681397174009366074429766037323104206179222276700972553811003947744717645179518560871830893435717311600300890978606337600216634564065122654173185847179711644744794942331179245513932543359435177567028925963757361543275496417544917751151312227301006313570782322367714015174689959366787306742276202450776374406758749816178427202164558511156329688905710812427293316986852471456894904342375433094423024093596239583182454728173664078071243433621748100322027129757882291764468359872699426491344391826569453515750762782513804991607306380317214450349861294883363356557799097930152879278840389800974548251049924537987740061453776371387833594234524168164283618828482374896327390556260912017589827502528599917438580692485584232217826858271088291564683006796875955130036108120336747472749181033673515093458888304203217596594052703934762502487370752661313369842416059710595606599978691384415574414466420012839398870926323453338868626299654709768054836830358211823411732418465771864116514294188326444690783859132110896575103960705960759221332366017786351492108205031065654198794845342036575384029879563161681570119819703558875478152774199628693631102686888118931916829977480173187035178669807064744583440003768601699062304869395907940670264065673462011834932716365990618313789462149345364297139262013102950348416258205180993059446210774987802880145808961594354895102827479645060157255750937695333802510233650301383825224338515519222281345728392711340359251734413909065761866616616377999268958496110050895945140910111905132580259501544309513723985720939476474894288034135662757457443388341239875567257987784544339806356588610633108535574181731756900138719613345695759807176534162557394366703622155529403459857085528107385130362242949094567162352338887788775259621682785843561999047226317958969924007441035152563369237496356968599770161805363912298556403527947611479952229720779961723024644092490022153525720742699177564212926919666460691652477885829504572484591086022761144616551652325977862376219527519755975987382786904230898931997912437157061812355181171846333497985351154593424046479046210361195761414293607466912075634548915883761375863620912312830135706516519846929100660094332304358827069548826263823190848877076695640117694884978647038043550400483475375696040067105754825453950700298334881915173586145987340866924344936773295877365771192461638400554711298474628924078371286503804593761939675541505805242328019089138696374948476035575783228204016278497018040069903724903967958484359627941479578415877005904100106611809214354834498618397063056949716989089398234912269231628661465014599215894763831098007978765716321691118261594487598794553213763786727611569677841446637838397121820097260886132720170120465450291990583358093028318847784287222583386407249992092360939461258866104220723568750923605392971969014030301782062398150628914991365556306507879698715718941600461463868660194366419292634986938201183672789592250316145933936808991993514320052071546307663504183182887799409617591640970483031067089227868810262114672053971388626984761678725059736800220184938164847589615401376053109380865786857293460644626401431777573112551594671453380763922182583620806524709739719037919340177846562536580214847129252458551372340559632727826855932238787155058841145465684272572012060448325025085953112512150221234750565784594703542664668012540811642015956293906035075247838515558710172609971148468632280952657055929045178340624472591919011598439503357371205962626203210432522137218125526543337397982520509154840892504231326830094830686436288786202702625599507243809062017484884298022788202979678307969549130709770035780974198602402400529808439161802962756482226538014898922653070581586264750755213798797909999121488021391511358449274461417915266102912533946869365520990101847525719319805416352118390550140870832387633435980595816434455148483409454025553456858134792809372207119939802267283396999134518443344433025681058803163984353561756006678173336183388615406233263881260148926799181936889580742367417648372060957827309517286958219200310497756127287545864812966844309325338239368697426584739993467499708138869650888181086635818419301730063526844201560270429955629078781637740273507223898811971139543197596583416975779734376027001114531765384473503422843851241139550027978375829625917508246804254345440889270855157126147689716446062605373451704888416639139476809022272115433030139137743409977763406292671811419162805301714975555634511619862769456082242438954852282033673242884108496619919310615517789823754551632817700476625561460126246843119866941995934691544956031565102557880683529736833026297020230204738825484771149256719551970255000026147718277596697527137940384868135931095737525273196852676281418618015945737883993876269998830428001097781341765110702315020317156378446195523566260211133955485513007092575147820905395735722055904877296661000042996578777334692955617310155569674185850008666926961048930206167638097203554872351645001412354382302351399931724252112677643575302861971169890739077812081897828277185767484441849285714976479540186912464740054260454139248116353468485804446329926990434518060839201641579757289079932072973186598444191220296296442253443428696150801867331528389806512181213090231590666533606319756614542297797838780575916501800951038876273182701391035506465091793673455391105908598718384747149679753683001872923087593330562479246877660810476886613010309519122363515089611810786284601746317561183488864078759849515525252210598076279112301082060449369148953989659556686669095895222031292224709919802138594638520248017532939004946374266017260113167925410857489398118011167436009411345444965610922969083769186172511211441632238105364169461822006486700794016131372909109056311124290926291387469357265932577133168692741215388274951528236712712985229762098724517787934331704093026627540885694963577247028334257862480681414540978146690567888379257117423476914764994071762416734666249815573863661709973520455101725520929842197111325264025512266687091115821049370585617181956617645798843662836895782210185453779169233792836327935545176827650907272797357551069931918281992872743169427343221879815638032443531571512210225541113413882706116388828344477156565427064161384180270716561887357842561573408960826499365391544990512087127700796698073940663396666811421160604752849276130132788003686210742816485801951065221886202823242769507156366297066314339191075047566808437713326685874985026006698837860549080731189523660702416218967108729559140192262812613779681813325668744339049634798843389409336531978406511658109062976115636956076363574198519207662090049135436143740312543392906893659898949062436956329333551454275322212292047557997859637305333812442035914395035326412253212048492518456353118852804464403988244331067872090192469428708537585009123682277973772506376880730478159388699086049773910042890947207967188420513722998365565819766092968257735003257583048779000765084886608915945362521390229877366341412916839361087932865573598073982026926689146529549860982265129715051500808099128226695073979629623154560190176961391381073488197084275776755137078212196987338488053078453619924183564891524980756516370018794057572527112760471672972273519354862785110849713256053625785452276067161605147354728021559305445808976037394030180351703851313974929014930856294395901174546422713075035127359084525861055166362596907281218966581125402359692146913592235611930596499764410195563192879831339245183344108072951514748023200603501786732978340220506923610706796085338257254101947231398330627163614232108003282140763716104004838570045668360276529171031656811459316892659908796125962894013684340627873702863822857315971463808853361340808744016727582503660335572662889836588902236487758312668993525880349555604234763659241292682700093100265089831704709536392854419694086786532430723579957795749015231488369679759208916130428523847588358268550101838744600482369322692351842867439119163238031505991038538232326377290735590858470488473780053765329490315187481770886128917009045677648741450591002465762997339991470925807285004173364238857467411512126602420882763208944486692056476323491389538725778884259313165259733861330125361204793689292526218999916795388241566933849148221081973542548244095146163924762042135961403528358913167287661348253806064730069106483193978230951098717715869536982403414715935400952869930428621457493539797878289471139966620720449233779517755619538081857614314481843068377724543892879958883054046888026467803506570316840709807329505811211541949789420301432128396804171686341845978556469339569330992651959142932288753777833159794712846491965288847884142884122465079667380194455193418510318577482702045416054377166080163716222615276058591510331578896149190714802299369923091852210334349329291702452343549234875995120044233227130130630614445349413844344928490379744013103659952332151414197461172918869498959967400092301644060302887772276211204955252759594197830760186047345623376666160228652551410943252088616091530871696257422427211693948910544487483405003331499199044219348957284190208186011026358444204107454583676144890783589680131865414611695679924118021744436160180121408810987238386753127751854371348099822734817525591541380533873398292984764834117551597800379441251845385462916942349496931704850055429550803639865565645605546619983348189138013988554749923071529343932388594111329695665110521027185818533638585723777481322050330470616223769372634150378820640746617326058706465633257965592488374028757789060415388724908979642569957134415929945772672117934340251894928267968472516013263030599267917145204566585287822389216803584307688607482512532719900022721127667521301269674821182804713499672716389778850104108677513763396272548054629155895156622647345865443303650613883819687941586076002777256113164827043306101839940653089877885727503320827844994556538850558672110877259534818128837181112135312469767860276459728396655160587006798665035294679565431752179517438663675292850100703985829597376252018358907162251379978133392078712900107970208199450389685489835835850535772860810309908855704889695881141513723371112184178335750472573782558679264946725338178207302257675121922692705574682383546097790624694752881806308757638470065239015019506242037710771417764877661418190625388355119847234841365698247385456103615295875714992201335559776231276384491580381675113432162388219976537728339236383897114484652311544826839248377787848904921845499746713881508183174211623047681022747525847483607285604000042184117161524068475138285772614846520397717649878340436425516753648070548928126616775901430567139493846198268485559403544070062941788160134960923986084729740421270302782017545326213881121910873989207189569239646259930099219180408576810671145687079137227808600744299388558002440425190791115419195994181232362493971263207229600044890663358172710901866622993694937555167375307975156295466209796439595880022858106641123010564333062136591842846362057376367427650054610903947220797073684685778987863745321293097132227197163872941516994931911122590707409649216236284119705244731217130500928415902793716738711632861067918349114278290748890140920465937910981820796378430539272633075126777164450955705102673749544883386541068666919052422559724257265851535793804492603758767755068235166363431881940769643727552489609621857928497595997309141912356250371716284457910002797706506320715361622341895208342277102321533288259045047025354684666237053322052440938321995154768764538205476003931663376142615220046503436032239382026060799331810394757043853879984969306976983669777060829866614947891216973209468359607771401844365059673806753349245123990133294746756598978246660271110598807134852431149745367979389254220212246365916010992864421292085407876173589538772529990070099162148231921619072779464776137286934146457804497173093293775074080470723025171724299968687741876456336692906959175126659810363104213334370619639002758712556124164881755538326278315745031629926368544672430031460291096092095556437553376522684889987737230126189449679300859924747918694889295996022200080639182627726486671872419301033519699329904981522117018386694273437973306883556952927190868681491098567648297831271032350555420237638763562609298447698602868460063200584898554580193076613695962343108760841190172210609331321495761126078922495137585110645008561834018904020086966444029266133556394475156172780474574850525614085501995890339465118029779258941842519885383936880805222659746128314306402864282936845918317752996575670062571279638992995892340498513243825255368607176877577796502298373144635681821293377965451833641362017185913479394281224963446638476014305678967229881471439198923580059031116712475042509417510770492183013216680246816643299763365033390142213718478203341174624504088208028105687359133967930740660483856058362643727539157754321258136441667686847517786982745192365549981122601496341192718140370490468426813716382463589743257486354880888500283601330799009547395895968399459867788971411834795371538496189430181740781691718173548455942117705095196318467034320123717168475204256009173461652239421457017700454008297648282157378187172760725910517609630855631854385584251060250231822486257038243729221120275381847472374727675442796051218505503560363515205029842629455416864527383450851712437054842842996951466877412562600394727894956753227892317987733463157348070565171574954751186636773394077608826543509527280954215026104939318251149717248224597998481050385270201826896465104324354788219991265204312362394799077402495147688167359009029911253822665501328894647359142828843015855800578073554776679335403230846389991704867373849101043594487607927429026768214058937278400877420414012106427278583500525979448663055003823012386082696359696975709704709659526308737462863688055054022721121189808915798046011079212867230413103032127579249457970257247759704266892397579151016939629623168183377206812078368553218037481450205061227957055169620224118187232342842941855214836828678447034243041774195247377492016509528506732184017871844205418420218624506699460899718027271607832518728287675150396921211154761426990441995307550959996666827567367204547160009711480965400798549279484009897256393327961833801380275762719122662463723464919171829535114450948903581163479938155719672670260324456303705811019905615560087263014279461430550807418812549577529951457938760529642934025463773635026801679576557322467768304873921136484257048439946246973969085144907615558523487824191054226453377517676362519888843078379575937550708774351581256644916770738420134746511208806478235385658390869469427566797914835562648247490783773535388411561524329636705454206979741937148600865828824065765555307133641234707240923082037161609492479333413541339545073267718410207826294972381922016268603645039998567299392657154523500194286293016955745608514877734675516198524098404536212563836271367540806891475361048960792539597116530199968999656452095176148720119784695796413629345726878497141324996618849530728308714359856217709871062233810402923407179041427265738267356751552118117960333070018207430075294593935506145935031875178409074239577448942933557110640003261769959553330659098271589415325029778646454346312382274755979431730314883212696954701994047486471331930" ;;

(** 
cubic_root_of_3_string_2000
*)

let cubic_root_of_3_string_2000 = "1.4422495703074083823216383107801095883918692534993505775464161945416875968299973398547554797056452566868350808544895499664254239461102597148689501571852372270903320238475984450610855400272600881454988727513673553524678660747156884392233189182017038998238223321296166355085262673491335016654548957881758552741755933631318741467200604638466647569374364197555749424906820810942671235906265763689646373616178216558425874823856595235871903196104071395306028102853508443638035194550133809152223907849897509193948036531196743457062338119411183556576924832001231070159153329300428270666394443820480019012241818057851180278635499201489352352796818010900623683532797037372461456517341535339099046710530415693769030514949589952161665911663338019542272664828143118184417165535766881832140589503272799127928026983572135676304667631409826930968622476494140464484288713308799468418700020456187690275033046203665644407179091196980397474788838026707228447481594820872396116012271067171066612781813201108139530097227226661910705939909901191206759999972839234010665112017261908678382645549306351311165772467118013661987390610857244224988944560935283818057572315979194877433541573356226311595461038207967346941503135025476073551453433424461165314322615014485349866683602832980563626925050343176583678023394977405157024328732956587653028673542262319136728400150061488547762972908589372758076656574126999169140342169228720667989164601581812852922185632265852061482709669693761466494213131347663694812007554641393149115472708170804166986154374140450535686496436942865468268050323625576976340202400189774509847282093076387561768341485471708922787978088375199630922230750920799585424333055600530141398002959265610286745209039670707051933220670000650335164775534326792392443529016468407192109040375770365934296127947126325201326851675245529357969957045653909018613602450501385677092328413554183401307615891413662731269785442444444893271976321424301679394389049166741038484553173092098892100644535591061999694839444092529599082" ;;

(** 
cubic_root_of_2_string_1000
*)

let cubic_root_of_2_string_1000 = "1.259921049894873164767210607278228350570251464701507980081975112155299676513959483729396562436255094154310256035615665259399024040613737228459110304269355246960642616625000977474526565480306867185405518689245872516764199373709695098382783161399155129313695366183947463448576570303119095895984741105981162907053590816478011473521325484771297880242208582053257972526662202669005665608199471562817640506066482677357267041948620762144296569420507931917244148092044823284012747032196428208120190571418899645999831750380188868959420205592202115472997384880260736369741788779215798467509953963007826095962420348323866013985736343390973712652799599196996837791316816815442885027965152927810767971400204060567480393856125171835700690798499634197629147404483454026971547622851317802064387804764932257905289846708580528625813000542938856072060974722304063135723493645840657591691691672706012440289670000106908103531385290270041508423233623988938649678219414983802707295717681287900144574622714770234835715190550" ;;

(** 
zeta_dot_of_2_string_256
*)

let zeta_dot_of_2_string_256 = "-0.9375482543158437537025740945678649778978602886148299258854334803604438113127075227936894151411515174931138211624163853505940417159617332471971851749124026882144437001639310150451071603735748731352956057133552593318050514872534799984717397570317550302619073" ;;

(** 
dubois_reymond_half_exp_2_minus_7_string_1024
*)

let dubois_reymond_half_exp_2_minus_7_string_1024 = "0.1945280494653251136152137302875039065901577852759236620435639112612868980395288816921562425395608973868765806327394330619423018463906366872391961066990388874500614478037053768511956654737753410432909101348239341042021104911276174378712312707073399640646659440353816505096689498703649934800476516537576604094118423473965149567793857228415619616363823012941699982306064246426048394525694123319935614068634305323678131896475911139214742172930676438469334928760007749800740375359856466847094259986144413181279859705479330957399357521641988466323051175581561949950052568917033822493319463428079109321077886242460055967658105859758658736348984146725999252709243159856784297351145627869917805525748968407251388224038214925520910585279720958938417356426382489048567312520701176210793704693341271357851963226482022753143890006555463250692416726513231815707802359440588289713931742995383522635596864793619979935366554074806265548852967650495251648405377105454388131542862425019139361380724333725282493692938578755281217194719835697214" ;;

(** 
exp_1_over_e_string_2000
*)

let exp_1_over_e_string_2000 = "1.4446678610097661336583391085964302230585954532422531658205226643038549377186145055735829230470988511429523184485575419803227050644507431903824515434045323348299589354600565058450155229216855356115763888979191269527071068690455441925402327632452829115155531294480526395191779440816753200019244730489909867275405109516334654321860031956702982909430158801267338033175228207912837451102704873260814978988983190463351143854405447262816274799749460481270356697908366707436286857745469285242239557660491219676478966504162461997038023839327097318593376749353786144331818222839808355940598080149837715987730914221376657228893083038653373796085635927418524207501700955503473378672633650172532071964633094039805791181211321822715792798249869313151257645431256672690785430973013197954007349759915411284195117795095690802080276708206224917028910504992550858838301530990168243094412628246769234504036301625290742722268679939821759708209959163409668272661675291393988743978086274424216929030067674616098609214653187573187305086126232965254339049074676664819105807348446759446087127244979017242483460404179341747714250050989931616597470081561793341963839062094592757409458111774150123401090738866584637703401804698629579215080920954993340355597764858183174482353473455817208540672671046670074599189679769953032351553703420171175453974166247809827198143203926183829504168693184240081340014797368333638242826144594773532895315646529427993252140944435001058155602470222707034315433467824667390320672298668340755575720341029504672999558891432765402324099908360099906068254994962205614450346406873954438690905208353252717530240673528702084400924827736996425665458538869892677127917308507971472097901815236540498385634815319237163639823489127657214172616278624432703958190123012591459364636457700684303609959162148471764293090265464352172321399050793239542414519952632715835083532242388928148062704080236468208418817964014007539984012140940632398552002059931845792571919870579761842699809457608403137282578292506081725353" ;;

(** 
gompertz_string_1024
*)

let gompertz_string_1024 = "0.5963473623231940743410784993692793760741778601525487815734849104823272191148744174704304970936127603442370347484286236898120782995290571966173692226658940243185135143682937632962547711879740252432302052117885737856177283652365137855948674253562181300812083378423844859598066698359321782648968604723109996451085558141538352061625750083188741870175815185793100506116043552945671034015036663635029755807141964659205370602563858754392239763839327096186355595420814111724593386546524955277108782999095803509299179162163896356913550697312554899795693719307178438701469672807751781700499106605448472254946244137072561379284901975499830037495298303842654768245311138966510460616056987063506834716189312449123052641499181843438277456488042819462656914382080186774444601748313698959152675647833695487186740099259602213107786153781858902163226295664207851298732516334848758834025684438975074794386153147929939328077843998817695892198263577406237721682280571699160696330066837801738278339632544426209799414229337385628490796642900584404" ;;

(** 
exp_2_string_5000
*)

let exp_2_string_5000 = "7.3890560989306502272304274605750078131803155705518473240871278225225737960790577633843124850791217947737531612654788661238846036927812733744783922133980777749001228956074107537023913309475506820865818202696478682084042209822552348757424625414146799281293318880707633010193378997407299869600953033075153208188236846947930299135587714456831239232727646025883399964612128492852096789051388246639871228137268610647356263792951822278429484345861352876938669857520015499601480750719712933694188519972288826362559719410958661914798715043283976932646102351163123899900105137834067644986638926856158218642155772484920111935316211719517317472697968293451998505418486319713568594702291255739835611051497936814502776448076429851041821170559441917876834712852764978097134625041402352421587409386682542715703926452964045506287780013110926501384833453026463631415604718881176579427863485990767045271193729587239959870733108149612531097705935300990503296810754210908776263085724850038278722761448667450564987385877157510562434389439671394429509260066782961819652860639659716093395833353128273752767615716807321951690196420724578844775506966145437379667573871682823798557571921419903428286722894917809656472723245360455183273688341979349581145497709879594970647587774356404788420783840317200610794937498514342848507542818121827763847107008928430013343347406041207901096205079600966957256606617065204899682275744332229689868778141305679410714248778230278035697065436930658102212059365744148111717372322044376207885775691770653530977435291385579208636931367256934994119537433668031809658792549783249819431959484459119080723629468718812314342471079573188059411629168665877899187594284046874776602916796426275176173176029678431264875228449532410503891160486326309580712207062800802613988163730123961812436859697073687897512695426891917718851472182330500260721398680077113065104042744612432418636538005821724437716331477461032168192992238880422697070054846741573798917399664629667243783725544694984451303822508007659860365418755296638140706405978149113966107310825202174733604913793172676414416872070100939381007659363791360656378830743436073339549024125737991091522518587344681286529833287221910116921836703851224586473924509470051806105676912398353017129631531317928130670873675512293989672856993558195595942576194069903301750916817051960686947952596778782116930308596118038967961203891800225090375471269275160190537092166047922404708309416240552805821234037825405031635884767385305129541900147968059426298242777017734996745786002038575746677162070901902201756573668953012000610370394745226690333490222329674847018388022672641358086323396965584421695809648659885883078785964787945274277326991008474611773087285290817112400532828353522787286349298011466754586407723191590006556417367299581161660855749873433075517030969167280695653202663209047583374547360436268123508018544017504043756080906361771198625470149048104379275794921114783538875029113899376475005617514738376106868341618440164912495798964383808812921962561491051901122911823612065514311598245021110875712471517593218049994701618450176846899022261812635774014019853978932640323786385253493641551644097115088418258263013563879614423017571852398499892146067182638553689729688520649156395658919954114782075511831857426860122373498674870269377784042456203383448711943399122554241567388165664833168685491971027077696622998133080121145563012933654211395517371249780456303105901619652899751196234842033074924963187644045591906539014423515625166139224777674555779001461298083240670561570473915800706245618102188658585974040456456638626219452067339034885937978146951625086693511616724093429504969947085637338958001476853062546109730748376302212066849030245002245041158352623596964842952259953997748754773060375131432377444155669094253632264252866815633646570176854539043225160772328374142235489458806852028337790028376352092746419761677099346887904937940221571672439522740132691815493434328136627024336195728813658138947689751364355698740198730204510532190210150011714590951429011319612385212642480325179599473126617375628942845133870702270951959022387235109134927515454530142550893141002994767608509974099495643092380868481746445893150659622485102898867337568536562053113285278280351437135381193985324853666970630897369008926778074784358432808168592231610023937935862567524585182213177412486056516553217031350024159764870112911003745379441637967667571824311172167030273585143500332343181952864044962265047451317936372089394350861238019804894013124903695750759791221648513922781016702444000581199558265295370743383107986866095266236801287979244682017813400494270034827947193733181042241620822455794255265865304353863376071807362149344444252372011622157846843555534601131362486554035416289136470782000305212931508564116297615265979785699352599457163263071573219381166066389951148022466666367079637253197900654223597796112430223855369266514443574027195687544688956958110007986602432617897216285227051503020130341916578568404607717493009597456553690821784854445871826786386" ;;

(** 
one_over_e_power_itself_string_2000
*)

let one_over_e_power_itself_string_2000 = "0.69220062755534635386542199718278976149067802929754473593891489996517155902908536212301238764935309834760400492151361541546843908266574243371525714656551784111012118004581325684010925893771483618960486085537343879946652796899853787040400275355096588887233775143501460016780690036801308541630111513237847051421431735003757575027827657890910901800419868861476858068127728546724106522866167178533394203986699512684407638296761887691144096768970964770952744814137508760262347108202096328364345869620334620993862514484308367560881003972238303450654011999302660669583712575390228335963343223317598290298325296741580034479426809617916562716602703751876293992348406456168072272178626090821133759976972454939676233705471764886959909661343202583435002924051282973829360881319733550247152310617878169931510859670977308319692497459453778843104776531627139117951829952777984784748083100509514689180507644575396893067426609748327310210350348865097934847108079588231375369143094903983519917287211557028561309044418018748727861720049246655346024866193001094782643551068607687413779478375026080693792371745667326920931738054051554242249897838297144489837734713137322284350535618752976286093895989639032722130480678499715176926503482305130453922095850818101953235988815595737184281626484649685339288973565445822350279492095445940680566081003259268179169113276938186323188870256490208853136983606712443143803762922403641831707414719079593143314102646592545748237030101570952500100174998657495674530130976736155424204383428711496304162222379650795775368562210611162645256123252749309026738236443657254192886318471249495662113016226965924032587660041596226858871842100005227499634563119014388646764794648285810011294558172412582269896636148795687517513422803093683960921543788798700779038740080583786722919943702536866284814961649540249074875351523999305921211941060037993733571079368644010896558441568043291595432404954354108447990195383717938254334408912627182163556098692787518571950661351407700606788750607311437028557" ;;

(** 
exp_minus_e_string_1024
*)

let exp_minus_e_string_1024 = "0.06598803584531253707679018759684642493857704825279643640247354156673633003075630810408824245337146774567526536141738591526812977776829520994743195503753158167284786272940854413425173624040281373075319679080836893339721611007132085986867373329450125117846511199737103384182012490878882410340250562968227999195052200716876992234099408140977876269537079321746522969414477284083134757793687286487969837972121942114360126409716777495118467526894899864788873503140061210422127402991330479389463064095996284255111740021712243015237658015483644862660849960739019691830444513128675013306711338167540042368298531300473719224313617955264178491864330278075613344916606523860908022946796285234182642655825560112236408174996780154739713976798263757331021629223944237796217138888371636549577694533983489312197194643498576817745878661766236458466956503006468840005204693548815809837425271401958266070818777761438844106697188491795066253099505511256038732830261879449858211296793977208840286917829299168355913757001865422780775332862089897061" ;;

(** 
exp_minus_gamma_string_500
*)

let exp_minus_gamma_string_500 = "0.56145948356688516982414321479088078676571038692515316815415907604508796707428563713287115893421435876731913100954504183815294964765104385205667809151313057747958292870260031414870646544898536405328477211580543159583446376788374801032626348256998850040565178360339726237476948553637188597328437148468927020966712340240735717852742632696218798915114734105359643954396180929458839301817871074725053658507888643323283317624778561426262665910695346779694244638109730255111461860331438877726770166639418389" ;;

(** 
exp_minus_1_string_10000
*)

let exp_minus_1_string_10000 = "0.3678794411714423215955237701614608674458111310317678345078368016974614957448998033571472743459196437466273252768439952082469757927901290086266535894940987830921943673773381150486389911251456163449877199786844759579397473025498924954532393662079648105146475206122942230891649265666003650745772837055328537383881068047876119568298934544973507393185992166174330035699372082071022775180215849942337816907156676717623366082303761229156237572094700070405097334256775762525280303768861651570936537995427406370717878445419467490931306980560163702111389774228214017380232832465287291389004660986659512444097699851459164287803720202510224578732111059537776807437112206240005167965280975444780286486006838564200433684662484349386918262062518994821970992423425207510492093445285124486022451380986417421061219536368310078209224804653079806562854154786061793155705987170215999699188228265397927803747127438635156296714511943986702682452679716814389772141359579690542529103548859731078233269414118579235695949376986012657588031279984679484673513468022653024462770569824438638729700298758880953411267542378902616433104091860701225717581666034510079098588808084286840740013403838132000405677583140619926558491845127806870837819198202812845022642081730224354601095412338871575982537376825937442618108261974718650463417452873248272637661583763933421278629358444618677226500353035131097140226114592021137432096713055954505147204649927608239102334732395201495304468001908089101037412807847539359160611641079862219291665624157286971019636369443758363500845526495936073271833152931149024594615904547697593101389084399751933133348433477200696285948743528556297391651507574098728381915385505736133180286124059186909373875909560442712511863220530973179836403160420097491442842555227369917972099757563782455600807325247976721458498517103721404406674873157772120399469746760971682571017742702091976625319582603930922294102726724544711344475350616228877691947616866950710887116942994673390516341643567379611607810782080925309343160677308435649505282277143899798591755972954046342095672245369518957308579598643134793385812415355675291899157522533720196926954880276460574076971653429884431763463713203880902338189564902322438404549924474378588959906250499901257825080600147842732190812817711934108024868894521447880640085291145580218572590239108929234950834560385598264413050007085479362046499862563501578061804405417874248135200069738483165900819542105115641466271702656052848039460906996074183387446906226245533123070003746761999924821965359200292985623376468387329994047893933509321888579079558108532106742280666761853263614256495835101702025138181821268264778420097841702272074934499757852233420292950330729579362706266864030148742016735810561115119140933150264112453530386361812864420158160056929083560649726579198229762814780621626924189506016999966646523657255267820360115441201900912876474365515347254068977126822504734351104238450420844021885018609482213474955937715411986797869406901368616991961290260081527978111345593390116335390332063036239926050930337510487387825129323182867557291501635809350054883222675608212720372702183721063618766032448320860058510873972259420402021732839200930702666581026758380968319782710140669865321655651908876853501690204501646055425696274997201851061994392484716368827281255930651110357011903772384664149179502647766324344903110604933597369307751543693916375069636837908788841175187618545795892326444959750662095009337771076527052948187501487954618625510971793928190375637306344615327443788644260965771903798281228597580348470380178567344461205480216157156816957565718704604822270628628211141265346305533954300255062929387759528640885004979653887409976058761847972051881407449924090939831494676302707547452061023683299266122338036652047950535395587261542739207773632052723475401754881701586714569894018921519193880329457862667201533527926629924358587337382557753575994189776992699036929853342843832745594503529817089980657070431882652011567093710443866443096324458514806188167500898899970525822778993842811875596117969870217991703566620053881920936924983304499189729814016476423672781258837208970232443016192994987189906657867441348308691569923239751117705773024216418915493813151331872222104876018630449436875253249433513525449837483704514494029181449878168061359701292352504191891313458792365601660548342810621469801384824090810669846170767085685899785564857924282402194928690482144323229415123402340487067353488086617921820698260187756567785955297236202072848114260810165814251172356630887346667214405755064751632951709237696888433710461851626922336997430989108175292901274456729026897398267322412205484307901349886509154522805054949542325635216190553843704547497658046774943354976886666574975969604657936559634358260375014325936534014108536530940933071023603703810210960333504418033446500026828172522656629218733068103308604187028255043031128085804875636638726987353344641500894285398583468466572923501425356405540074529179915839876321144568767670217198946211327367433659212215796547779840135013939581575029998309788085684387785690874319389225831713407375943246998104726893945574983977419048817505719440381194482726365055416394529385023976318425828473726178514373156770369601906483482160845652447862127420814646131468650282625925503737538301804016207199490810106475192285238033922767863780524249883251503330102246571151978692652708838689354711650504855367013048084537612063181884849418069060721506913296880645361700199073464209465192900024373138841982650560792714648102609555071446761017633568355591661311936567379998436093917299622324589324267935569164760481519092162867463547970866441954615923829401162179371649318968810505190602085391506118242697656983735012095200971806014373878126407313565412293474558497048135615861036141413184366745627830305377197190556576066236193466219660303933611457032880555031901448584661557878795716990989636747333893063473430706501036761944341196758158460737266520712984247289322558483581239022075320148434047341543656233413013871387019594991544773609045558244750536091386998883475017517860658931731223068290680819643240133271960944730318954264562465337993541288743914044685265869684888013287084014418377776931719549231983169199982843889112520808510341795692623364043981983963128160281444600897621700699245717417420107664358501274174184771572661194748311584838869196703144393823089342508678764977152401140220776085446190456414446822433789704093292031860360113829694166642478717205882024222578801145523141536683669229311529734786217344654179702616836864863339499713072862900573734515716534500666501962351552329457403769234646005495122072991406185988955812305841818749655509711812164543287171712717639249401742476715154545264238620185457154620973848007521650628352934201627608761476938851309233389278954976749196541501500800284852120826701884012419691634946140519381479099717211384451024901914563151171091631189614222248052072388655676422044169833916995459050698200059848808825332052302218534382103663153041434587301609749912935834330571898367063986023976570217860878414399715908345499184027778983111390459768714416741846642660172741310016875498297410066094152906536438942875283746741261371155681245232355988839735644298320927261630410887181712445718308922356530754900264063982532184324189337770688146136469873277333754186312213046603872637915650390392459392171779937754560843042554167540337834368899663366605897005292579693730765130328561614211663515792543265743245646456301233601498554986931800033991654339912025960260402340634343065644117712233580250617770436239967580640636524315180852668140884585066781941957307028574270412326416602581494620189216854239550746132753155458357904647968854618482046924284150539290983398961908188174709206134955882747787667435877548764171453603726061839812978696543203407802589408474474526353267969259940574749829054355001368592055747391188426980337249951840967652222312074638032974733469322866571753903353231632201537145455076280510816376149035959720954073093067293076431105396958718486486181477738102263426286427890561116940082753118540387550686775104955868138703817541913276236513990807247455941952135529925767114457620374347405652435045786714555239113081761034315771605220693027381372065984152743262346053755843062933114620558864444294215661431312036756247136531337923247716559613319270116963909315587070545209824226313904823004243217381435487562567643449813317561489366273578901166780930354747302380244656920293969727516115277217482733819524443185463690049952764021583166958713996637548234358873298790304442980309967910869066387633681839553674580396292731226636194488274575125951310709789961546888223657749118137726673562886144544488289564782915082998840659546460369998787409331138300923904936424648736791307531873114843250545090086024806659917866772387465882527713630378473106752869425207983298333904366175303531589593361853231916154783274333104573807030708131747959428905816723942666659380494632761157865094987731550280301387035363099032720287388437348505820139554016845607652336654416593433311201059163792230262781476839798832471237348530813571257336258058491045323346674112018333063340423940883488103429445618775227198352955237778320950290309444876990102358281329480666655243523306381638509004002637273446207840058441681830543036373741793134797211406249680438187965078105764870809074600533145409574510012912228419823080029355388675170041662957727277212067407292584894995567066917869209368017562716594382397079150413885781563621199522416497895560731774735975490495266556352501054308741257348949871882883387067924254585239093685841449669579601997430953719386495529260719211200317078896918760584530630460675501744307815292144268897830865763347229825902168455564492655607099118224300215434134831116671819417609539030193859233380065226859210550582988448601276928147371258710429899330978273714735482793847053318253743445022198568969304266497876880582024520780116444982926341685617690723125638924173460190172487516320006633910111535525361499052165232218983180225324935247412610260518462192680550463043170478972296873819" ;;

(** 
exp_pi_string_5000
*)

let exp_pi_string_5000 = "23.140692632779269005729086367948547380266106242600211993445046409524342350690452783516971997067549219675952704801087773144428044414693835844717445879609849365327965863669242230268991013741764684401410395183868477243068059588162449844491430966778413671631963414784038216511287637731470347353833162821294047891936224820221006032065443362736557271823744989618858059591684872645479013397834026595101499643792422968160799565381423536206957600770590460899883002254304871211791300849327379580729427301931042601691939325853203428968661895283290521711157185185506802254197204566370865568386830544799278170407497768540367556534957218867882563994384718224585889428535247260568210271076018491534518468064887386774439630514005169440540665265430968869063937315359837311042174433023967896690035041181486053390287203759918586886897487324321721585596074334676426167856117353336421265631915665454892289692245773889570905361803836197510326567943624088359906422347128465334373148717065178946374273412694796804321041476668230286429344467874583036218963523921329324375520233126347824414750800627831282927151936516683092962522682971552125741093828633003411897142507039161880015550503803553843718861603288886144250899881003197448339122303772529361727307574134362759044269954062892257908757705291101487630260102052478004206277235139719507830448876238398163941174446827974730802486588543696271962723880546618553419729373637368419148691027035328153724386748755117214258310847410169225398434038980853491740384450721511408761212581190832133264923835593491754167962282322191228011153278155204219018025908891765383953674502890902247970409692405785082751036913560354420871706508620407109807604764966449837316163603450827937016534044097441642023703410806122861535305138746183274011530452801071709010490216621635377646499033264932280662787028761132223268803342739479758297830428171940689683261869189792204372346952679542510781571693303751286098474711457649993852939553172993185224036358516664323460206691753893686912422507033520673358633547358875825685074153842033094308893131345705716033088381538800504452907863703981598171970921717902511887696724028632841703625672494791651320238895154596088408050186290838580481035843085189594358532168161396393517807454063446339968749650173057777744258116535464257730771420029454123404787847316248466745152361050882905703604498230376703340240226504235389465900223099783347649614910356582290356550731766853975911910746202688908388745135615403239288022221725455920512691043974473013791321643862047011511401952252331456616095730115275198105794921389057581899604069596312018400348181169493900500632762923475243277921938328216385021270164263681502896970692397118675914204346025209567370587484939686481736835309890886178757055350098190233382599980455727852434399271283305687364708639771893621760100124175297705664141792179364855677396908563589465417348490768969923568661640518224884603094790569591022495866012011445605013870930489092384114472366038957507636688016240927874382373744814916650614964417835499690440578359227244931236515185766806020869550253766446694082251835120777892599001327222957119361829143530846402091415726345692213517571401822146205028170456034371403687269158576340545739829098352283077029287667093225004263913090050739682847703779856625416842792432550203402413428541294789909000898098693461858186688607060762090953500339464606516734501811483628242252585632808731673256257434598532767486270795829193495190539036088759411369318223477773161684525680481157015658081193600273562249181657931076574049762471337149153488285055374984402971807265324598661527818241276524939991452293745346670743725231341876484456395225698215724941630362119767194560138326404067453543645450177729297740351386800694550777684571313282941145462456613557751403966004715191533236797106859367653313087705155824966589154335605275410365300611426129360904442954486182159443158639568286689752024409215312802108583728336953496882031714728135451194625391231730268114209967817073910495844777913706021293115530486281301382266625229458162718456028463865879004483202230406831681996316039536428156758520482690103982742029454980047903034146149921793383363678235981221060893534718083901897228789865384560569608078870320677896324906867639823735574035375558481160809838619270551688923514046990660511140072896133742208655234971189424922834230143224068158856994814823887995135233753229973447855032760252884773932621046682174269338931761295250984747504138165356384062608334290422434220900128127653923205925952466762258512241619318556989790744826403802399650526424941280974472624060256977463441304053665109452426288751383309082936134624741933237922957302399406551590580236766203903859557822284868400314720637637680811871278511142546865006754768893058619320291677608475718377710744737574994822452359332074670151386680646665352175620384480229864105082880688043389335307661299677728379350077524855876789194128395883222709514431750576748884395123359680860153899816120343861701640009949542826862293622241916029918186565601791273991417827293" ;;

(** 
feigenbaum_reduction_parameter_string_64
*)

let feigenbaum_reduction_parameter_string_64 = "2.502907875095892822283902873218215786381271376727149977336192056" ;;

(** 
feigenbaum_bifurcation_velocity_string_80
*)

let feigenbaum_bifurcation_velocity_string_80 = "4.66920160910299067185320382046620161725818557747576863274565134300413433021131473" ;;

(** 
fransen_robinson_string_60
*)

let fransen_robinson_string_60 ="2.80777024202851936522150118655777293230808592093019829122005" ;;

(** 
gamma_euler_string_170000
*)

let gamma_euler_string_170000 = "0.57721566490153286060651209008240243104215933593992359880576723488486772677766467093694706329174674951463144724980708248096050401448654283622417399764492353625350033374293733773767394279259525824709491600873520394816567085323315177661152862119950150798479374508570574002992135478614669402960432542151905877553526733139925401296742051375413954911168510280798423487758720503843109399736137255306088933126760017247953783675927135157722610273492913940798430103417771778088154957066107501016191663340152278935867965497252036212879226555953669628176388792726801324310104765059637039473949576389065729679296010090151251959509222435014093498712282479497471956469763185066761290638110518241974448678363808617494551698927923018773910729457815543160050021828440960537724342032854783670151773943987003023703395183286900015581939880427074115422278197165230110735658339673487176504919418123000406546931429992977795693031005030863034185698032310836916400258929708909854868257773642882539549258736295961332985747393023734388470703702844129201664178502487333790805627549984345907616431671031467107223700218107450444186647591348036690255324586254422253451813879124345735013612977822782881489459098638460062931694718871495875254923664935204732436410972682761608775950880951262084045444779922991572482925162512784276596570832146102982146179519579590959227042089896279712553632179488737642106606070659825619901028807561251991375116782176436190570584407835735015800560774579342131449885007864151716151945657061704324507500816870523078909370461430668481791649684254915049672431218378387535648949508684541023406016225085155838672349441878804409407701068837951113078720234263952269209716088569083825113787128368204911789259447848619911852939102930990592552669172744689204438697111471745715745732039352091223160850868275588901094516811810168749754709693666712102063048271658950493273148608749402070067425909182487596213738423114426531350292303175172257221628324883811245895743862398703757662855130331439299954018531341415862127886480761100301521196578006811777376350168183897338966398689579329914563886443103706080781744899579583245794189620260498410439225078604603625277260229196829958609883390137871714226917883819529844560791605197279736047591025109957791335157917722515025492932463250287476779484215840507599290401855764599018626926776437266057117681336559088155481074700006233637252889495546369714330120079130855526395954978230231440391497404947468259473208461852460587766948828795301040634917229218580087067706904279267432844469685149718256780958416544918514575331964063311993738215734508749883255608888735280190191550896885546825924544452772817305730108060617701136377318246292466008127716210186774468495951428179014511194893422883448253075311870186097612246231767497755641246198385640148412358717724955422482016151765799408062968342428905725947392696386338387438054713196764292683724907608750737852837023046865034905120342272174366897928486297290889267897770326246239122618887653005778627436060944436039280977081338369342355085839411267092187344145121878032761505094780554663005868455631524546053151132528188910792314913110323443024509334500030765586487422297177003317845391505669401599884929160911400294869020884853816970095515663470554452217640358629398286581312387013253588006256866269269977677377306832269009160851045150022610718025546592849389492775958975407615599337826482419795064186814378817185088540803679963142395400919643887500789000006279979428098863729925919777650404099220379404276168178371566865306693983091652432270595530417667366401167929590129305374497183080042758486350838080424667350935598323241169692148606498927636244329588548737897014897133435384480028904666509028453768962239830488140627305408795911896705749385443247869148085337702640677580812754587311176364787874307392066420112513527274996175450530855823566830683229176766770410352315350325101246563861567064498471326959693301678661383333334416579006058674971036468951745695971815537640783776501842783459918420159954314490477255523061476701659934163906609120540053221589020913408027822515338528995116654522458691859936712201321501448014242309862546044886725693431488704915930446401891645020224054953862918475862930778893506437715966069096046812437023054657031606799925871666752472194097779801863626256335825262794223932548601326935307013889374369238428789385127647408565486502815630677404422030644037568263091029175145722344410503693177114521708889074464160486887010838623114261284414259609563704006192005793350341552426240262064656935430612585265834521921214977718780695866085163349221048367379945925943403795600021927854183794177602033655946730788798380848163146782414923546491488766833684074928938652818630485898203548186243838481759976358490751807914806349439162847054822007549453489861338272357309221900307400968003376668449325055676549375303181125164105524923840776451498423957620127815523229449288545578538202489189424418570959195582081000715783840396274799858178808888657168306994360607359904210685114279131696995967923008289881560975383380591093603412529986567903895687956734550833629078238626385634907473192752787401665575311901115434700181862569712611201268529231299371614039069651122248166150823536439823966205326333222485051915936826907150043155898718027833538454483091072494980578809617179963371670365541800414646675387195869484833315435833306419359294874209514788323477484814181497768716944136400566451569361165241615557341419354247213730674683338490544266260383727882175527099309581410261369795007864658767716086308044607498028015769626759138977947722143375154708293458791238984330550672234749699849424867067215025692735295850658695889974865355621869580439971251689766541698626538628919775421877219396058170011042364141587808103861721015575519237111600498806822916180977324219583289748692271839791904677165426681388933792960368154579396113396219222454301515806317437084056085364160313849829695185669526128221237169393681303212965619397187102070980079488339101975351043074418234488333317969782773320911433245143050865734575006873914754707775775599184671183085836601594371937184490390617702325365679775967444757475115841957467009973450024544284065850245085856463927912461198790936930720198040293036037388384307421628212016353864662260971989584367994305720301496380508322323658255577245342371877374398183333064546629069933111259737219502746468990654571554403039178354197564343157390348838667505427421618310500605504642235457084273935493590517627174792994723989086329701019056101077426909264752357403046301592434424649008341886308593206855225077909101958588953143287998175709819168293159404530056325433144885173573026982569372534699640134408715801081452878657904086636379450711085051042417976919112926151320103163634980866069486244078006684006716962214637181147772683418466463642427340530031380773496119981468617685854631208163164798937964263738356618938313710983289564905211488134029742388868631543132978765799125454243338563472002681290489949550426980882130267263581532480675387903230574210403301497887867523778607054688614721009926329425108878019702841179224025910914665848092578571927862821476670740878635197142562924278670284077032414375699318832433315590024333047691110092479791180062862022137078006217257329047359943988831392799279693970635676281166940541288590819820238382770354834968797340488882930167367709415846544009548624651461013539134968559120402363618721509929806519058616828153028750427545258605331963432595777478813437239394991243806143754498590686075185631427255255642593967014980414259818237852576829436395965624388520656548071038845463944537701917845718741011862232278025251943626574382422560935676925823877491160737759451401447031902241535591125061381782974212649826416187246063133408919267023597958023658416317556792335662101231335845494590590069984200672260251167743847364824385715407146265945642391127170780306371416926386440100571310958960632649637552956769364689410517952000616452021884353404730182439305148819845930762964044456877624165287162072767318606325408014288745711986573074717018866036879703647708548528716700036229285288374682466058814117540474460616763543037399237565965936967087923167744685693108382107830483159196430021441259702289063203174101149366480952903011716334531917922939242428772837872349569929232136092234947226458243755094515335520117612897517339513717829332871586094386627011791841554587264898251392555943795197317867448769925326179423381299941279398602644245196006054368186646709865944365930154376291486979597694996533527210020020967910439482547244113342244870054637656840866762153373627461591205470086290571698257353705239761231238412564349411789498615828597020971097039196352168122582247562719519382728285209147182375343655254020746203066730476952470094413814561782826663196139673593672572646033884946424894724489784815967153061538467122369871282319784769311057166236373262075959711804015143896231706019585709823813924666135279136956376559048616762051297409983149655978602534101294543998672883006244084401861815117506870887646716097992920177696249633015758292596188494858720022922480606288121778733831458825512939536510881918651200449231549839477314735786889731420473109453814648226321023310794395974628523541295751910635587923001956181312946120301575763401597856817517498423778824473753982474575996867707408545574329424026781938482203540962106060721924990825104854003184963199863221569089097614053107165113129326853498524402864482934705916085869959819889039599559181107641344665881452542565881535450288847399753243278090215225695218441452986508355129839802262382649748818115815250345997499159664009832014520070480355568589973099815031041922385089745373276129471712681653088670054728865779224670178265948272609722903471574140316697310705050782961082607287042912608231197415101473578478101072797112427976028481411516338868969078671757725938152479612378999903666175603588218132546756344830914872962669372198850270018829817301702494421406317265197139506221082764507181663910436683295663807307194543211255053620896783230310851714811492858899362870648875584389130047186846798581655521590139256032061376427156280118971096114002391303934060617784821102217165992659596829588905449896485740412204749735425646718402365046790582748590695047355535311838358089652886158894174416219886804230349243895814973672227495181127145343869749924324213868414848375770331087617671331994426349880672166702983717230571304972563819884436539981947970223275432911444433463252114793188464973594694484809517347709407261091493510518550431888516380180024268176317264589577881465894731621991354217970696392959125603838048585831567272541846146996603519007670111782305279998313186980724782168173389846912490557910867065430256293808109482360911182960668949738197631510515384935175523971928535671639294213365269580491039503518402421871935461814477959700303498159579720430677759494490172314237985974762677078008980118918522229292623297292806314764810011917099935317697308942263740201007093350666227855337722176495694295133422170561068181275696140447495829039286085745738829193650805224286122212754636351051367221258224557507710935548241864408182186806578080799719517709474197677732124823714623843954879372675599911702819706075635766641012813500990087053356200523369296054295092545419735238087726164472653722307568265054845096797718992008548913474073964160494124035553268157246269023839385187188025506849257662387484058760208515682269637595950519247241511335163399791572224009610878392752258822130913709039825360268102671419245765661757745977814068774803927288115838175631194773765607660057264678952979984580986236663728860420221081574622480753444710682668245313146783013979556546944656992479884773872509646762389036794155692945890076145200788685363678588126399189591576200432171996367902698829112413538003826280315040300397490143536007249714922144796437588216498521429139153842734092660565411078590098047548501563396294110068732270885803892093866602669800064737282478204124119241732961887633805564827656343628060224348264275294448668047095582148258986443016881299385386463056032360997731239608702975422709483861874825906612323660796110832087609717857851801550148582132699958031669191755214285072089915579731076009248293783016418202941286326331963178831901074260096616164743394154710304528365460640719348240268087480514138683169741250300202583706513196961790813691464576360418232854233017738839045345749635312431878972696224389040540339039306952884935805777761256433715951089502408998893185702031780013280199777945931122995523088493387501718615418603641767395676490563615988622436725295694806198607690683597245894241067606469844393970764061755035650027839921735628683961804084163691192115011557769486857908922471487845531547682574957260623787980149706747223546404982107766859413968507245085143390188881730555369316016706539093911474320993348089767200168844178342988840477126704835769352300680827541283754352985735533050797305006712052401289557762367138428116947635192076990371894303804216371438020260110666534817950223654793917178839657146564474374206686887358331997949163774307809104278498968486960693414504621364852377070901452219029468183110105954590034563792948098863014998268544231855008787797230249495548680901708697654831156157276220114733764439915014185679907400300376725602437413886018262811473102546951894785578531365834695552014098212875256396892639185898082516236724064773919490085019462817223809657396295790935602068666584989340800634065501515697178146399656930331832975183416364087580730868694337701305347553507073800203767879714989374913285599899593202855162022483535234306250045419424974568657783359764165719518955089613766159654417611259243955778743990290627677159785074420988819643335932236673483397602142436566822965633862964366430983657905027742858329376251513041986499893239908267210852514521966643376919291245683079020464700109775893865853619885415872309552250293841539831450456825820961978063564201816960201594185402501085199174412320443594332553867486648936930678852959964464112849960565265236082673989819871175487740969391875316179460836788980226081242434510959956838680008617993107107029638814049391221574003954818755785922316123472118696303350553114708599233588578700921184132698002552550909144059309084817943620421149493800461925628807231636720535914404915394349163230560902343058426146232310502728056817747323023816418355694426887872912145908162819530945019864098633705151883699368722723212821579442611693259258097237351456169824731330384495041253660905156532450827216030197994493380764712349579213422816219071874389822734208602845477210672071476988552694014388073809393804470767794813681565899798368242345926071515270126980134428374698067667074908821906847066563556387993593946645549435033749338572366854345789966551386202315070272677577248748144286567262184147173278247584208168634332721189860384854071552942803791216373474719362537849890522347130871897664792562578430288532366722966551709021660523016296046318414083781215544500280342434817679267493928037374229801809302972274205586056365396307679886665317308596578367928006533733884357332821362579481072141013572476633003767021606441958814972809253810971730483605516802977670338571161163573792727185069574830898541786532522030558432875053657073237687839536670656584371212368194068868802319792659924226363888911289469040202113090926529044403516719558890258545356590756636211706424930059811694396536530001446071377786345070245262913323906664804267449716578267379986174202587859007609577702823029512062379058496854579125498749392266310424310638612717247756718882064738362117572913862923429920755333604151482790527586454384632305485082116454896143703211058166706907167539669969347051956972801618758656318296716389833503519992235875506433659919335054579899786089015056913078649912955515601505914855700720851212223732360148292288081092849174671046808227967805854622742571191906235190181155883933458092085005984334547184148384674544988212364043365707728165633455569931284301684398064101121424101723351739141677186945387525989557375580760150624134716218794861885140372198002572846652740129660903570217142186907445861335552628527210049280086765506377477202690840283449490101226950837017567392110167936194822273067202743064217803382385618264074241669287382792673321824251225279349197657547115315510316340080530580467465370601531163044579689942202337473039974719227940034852944397988360621967560113769553449002900240247662899731389264940182097756599837564808681717719384959562678748426499270858980560238395766763552822596037306172781488189718885258794608021622123029003330660818096092614736156095938124957920999443324157157484351043096194435531042541649161502891632849623562169281435062845211784988244473867228415903797619159453162209987956823718034456740302051954475177073411070162096024318802734425011109312026862604917826197641426991235811215471656463287512484603283482318311833881655749521399855831725095951571142709720147189253578421724978680840304785325008894778258643717554092728279077862914610222556929191187410934457116406047642447833729791916090996713486503698919071648771416939489797150713479897642267424724880016014578437241225881687256628672075560560808458091244755753995392024460383580480330166358858640762361002346924936754652296348525377821753694315344402764479892999657809288071235362059072642329459976592341072160700730763052854183769912203867465618360157046717192105450424417738624265972777792503500122377906567022754878855145864575006557966277100516369422240734116898751062309928247757913358285976514483512619817750977045754915954709118905870015930336656228785939981893972532983078574557433238765786882781484344714256703171408019643591520627978458182166389049433997887319623334050880191537474028997377863762779739819468186547075208337751546071227662096120124828683877839339364404427820685062619143565414985000107349528911145297568589807575329595078526420619789831531865702535430999928742261895955086753640405990112880971442086573328374857970780717283985663070758964225984086859143163168303988917672202131510815411456843582244185640494893524573517070779574347146773912471584457650306675214848348670881942483762918493134193492705957140694044384866560042900108704964224752239663703782079103238135809167383940302255490270136036679253741009303510302942153500784231221936921131007355005177821255901800901897589489568292605007109143528461170164133481825315057680414789141568784816074110416381729521724865165623274335933646452812690483850804167441488165968929298750011765250620391992532024424998563701315210432057638597515969977758789019319265395507596203438999825027992376697729021055212545393402864748384179132380660591410934599348763258485199292284971939956935071779670729602038487229237471501407657861767711744089934001369272441918296856282452517486579020257707165830298539350660955405716632411265517242499900482051789386835479369663206694229581610506040303590405856620695776059450952191291910302650435572128780909273778254477749363438333368695005675237951758381163652578968936924203483148198993181576759463559872683701529729345397633879533967248436496990899554002952991556399919801121201225495918645098689908645351564757386791252090823315638571132592058133462969470837810780342136284989767802089711122826782698792101948989871566980081066441035272581234080564723094433969036250432977464201263135613415965023449915047747657053661252719421245638888612223556817737554202813937164012450934171348648924134240253083052283703421089578658744234952124217825951447492998414866322598036318301992232284606576033502687040514538893318514918215910495383800903446443664618905500309885635191959083409910336308408589179720584515122806152343481791864316041271999591427454237563277748428861885664006173801438730607430032076129083746379452755660502816668458309424637825814923208841051222659106094507826377087419622623011545966741277585380842023766738905165359702842959578332106370092595101595012349543897960412023250930362749086301486539073895824179527352847453576231209115849537501134738874854288337668738798092203923588909176003343605173415579501469176343249183008783374106882893483936873927674730104674256616952576526004525156166394120918749889442343405276820822019410313786983184773697423254037085328291030818666297537219906065547549524697215602114486676036062020126341336839823331788446486083372671027279146821748942072057564500978684074292196829432061668572871874499970949114143041677151056639398930895329602963539323938342568801163956868021097161665789817082226855895624245599363890759373501348899526436133413332545548336691090774205702940193644269718286501055212815136397370991603614189701238061030884476268357078937039905094269558104180740472844001692067020855185592464279179870870357294334035576045913320227645870674493969066707386737284315524218278778675618127104640796374682423853027962249369156643499867127907150943732920460701403303550243486930040663308685727385322729736771648151665548357549970802964767719917940641677378402114888827020197783141484317896051144183508380984163136907555065307446644969772998531086523855313648299053899414551607865148138194359309590118588334007301612744632638904557453639751899561087281740303859446971220231234189878837271727576693071859656818391386339734045080841619626295408116108956674414909751625707390070758631898696327024118778617493011412484664605307675627718386369735579658088673568088180361208786819110745655320807411959842342828352319579104804398899278484469364282728405927311746404568356504265977211336913878429853078352349373691378726711361860157045857252697620888480533339961603409204448746029580566884594222320049703765369625556583116201483872656087534850991392198485505390434997421609756284634274271201681430895570143598625608034084905254477665397924303681492657698550635403610527332589343649715245508514303837183142630652479034685749538385666958887011957695229406720650114250245757614206228820995985013312744293341338860323110384095076538019098521619160568770322772200951079090603957916760821487575004299252236715057487231122162212098544538496426937735493250706473641053210895963116575184041351665481860599008270275723273466615289710570619845523826654561782715429401586469101305515348994782435043873824630656142099744745353185108155893640821856952712326671470846928465317553098238883371224283843214800435065069820451403442833017823315035005389840694998351793560805111544636892362043734161909453465753688878874557508041955950869786945282814751337178935777829744036621859127931868272026982591051643872673291381120126967285433014498655272963636948603974007476632753506491023612058602678290247373438425127709868618084927178993991289710453442548858962359458455935905691574018186433405204222355109787359716178374863022638146299904707099185482042676561666820524282467951024334484367600556665579457254401599907505937487091376607829564078733155298252993749493405351105546527693968777894508284341298692883677456499960853795169142465922398091125408984465458670163089507736001661808264481538153795051822658128337502045980033574796178224935514173839836714431445010007413433550217039294477952570243990090581226941817881365905682631397144292380243204290682159062439558310483585655760587441605461465196703478588806662401201735239233899517187758356369093925346447433258747124545728576808870917951310884382953028696696664384089333844553662885531961370010148702940505608733936521800689181089116297040201605304804213034009048598759204058478651803853231440985127625533170496356915553006955011005129737034087784054414418131671493865189127442806258634585180356559491969414353788999545708391278049387573326621819533038439482397043327062874783137883118520013787562952637147370981280505496904553788329650160508764049788443986739208308063850830063405739028760390238467895045556495258638996226969784643101414515447964349012792365485109220459742866654279470234153985014826586828841118045487239505791394436159662847285896739389749136509059158509448351542517982664447362935138781979882413338351489446982071453828958394265604059194389789272104961510631975710340121184599943160464789548435468824072509736135538552506801505495447526930134305692152690902036024552515116923082109585503041310410532556881064041200012010991361660551813053751074326636448199883756343888138134224948141506543736205328917880098955489390126221182962914767054103068078334982471556921422692021991023064118035779445607911371002326029627640134231052326717392326922236601853814763877143111771686911441930940706527837247402154732401679848423742571711871790095185711071618453580073298482251062276447217208141854508273111320816124149060740368066751379417131165786805715640220456620481412554696964489619528417302081848994140861173741332440850764821301635650511092317213223203345313182123219847646419905255266394708730797475745175746754661622367315418319921092345040744650388792515362099516965769524118039516035181201307897531635030763544808523484291060613026002400720878326643006191205255573187932915491508856427879685603111011318435408072971088111544624041175372705481403987079642804193674465862083594850955754443062371886058946738247086739744217720465596336640176912256577744448515039496598926193993179738803751049289871857409343914409129368267543273141981313918115670464911813124753457921454569407933726029010189198615086808318989292005504550636546208239042899471538910732315716250077866742126400931703335830973140272120124666450698467447668748695446627697930166395372063317716987944430973982790673748847135831517533392533034702229419478574620966715818590225628513175144311714620475936230771768982002113336654926360965956961674592681636969941561368137659826874671210394501582001539757923827660642611251754646875886161047536382518803489655630522335876074960932490312897385737731126785533531070483968605320377813622554569961555028172037036329877539047846938566660973276841262201356797642704272245005525393684746286155094992282130934617433662782114868401939995884709446171589663850434502841808546754891994586316475342379919135126532381503754527795362853545587123673299231785175448860910977672784015140453720822786996436824839583634321720085535761694102392297694916834629258942529191010832747258702396914780750276833407348559010534576897392663415565216517357810804891989118289979182123210154515076889005435934649870234903682371604743127661069843844154398567626537888321832576117740178984936439145032447073582683259421993269281562036527716481843611663897395104010623708330882920095034797471931863568134330101407271791638317908098534747202510157511930464794495391082563568306775808398464373054930997861860554748732011424357500873816334329201235990581775878343354997506605055988610880273547867254756955926549950232729263228947552939325701575284677578263694811671968802435103856416192062885874809080998754846743510338783666422272129369296515666362394755495617226287608771338606320938800220980217704973717120758703364279381184469624737195926802301639169595620404736868278501401799098724371179780873521954753532673387672154950092222268018256974701918573660053168605062509065337651345525450401873038367956247670437431872446113363313498783132159320323253859996484536640091555810417378674922368558905637553457672204521429838441721576775967266896051520248560153235958210461202779161506215453577374969275111121587666723506927122506328913341252954622472437597782982556997054399596505910102980057223473968632901727353812676496015144577427445622544340982398372803994623220761150028079416100868799041637537094953617561875528172957085725125296048997337609860683874733409910494602951753518142957753987606835994318265795108643309921209616216701671342859981113500742301205582432186143855736419644251233512417172775462463918114214894771428388089105875416072693305060021952446377683488807774948889718894822273000609772112797752257308857429151399949666052358151198885112449652414993411321778080242449495333133077820103046388005837788526189642909587277047736545498272938934395963799995839412081324630672040451843435146052438603140415864261413036682524523994559862122240980044706277395411592929367019010084565063642148611272569691974048076701587037565374678876474762145146500456559248695719404772307711488634120172646328501832682581501224687496426996713145364280083366659002190475446889599773398205393299714882089447232504026424198399985995434431312932705916791064486242324196127365545259567173077639971090815295894738013891912840037140830644118848248905168277564544846530660630796021734391846750951299937095429288981179261781658217547066074915032927105382980339351373620742586907575706620485420929925297891489946672939981263075948990992400957642219101884611378603426401246746071519388547324009165660487267851464923443672816065326692167461893691398144987942754665394057694709834980242081955374031415880200114675722088323692614694203453686822619601138910191091465486666782158756851106955386067105822439231542171416793797488119939529381696576886889456519099966057062554167228804369083549164781364851769553399923071595978181556576088265631462154336588271806049616218218501975148933688930529219598208152336141755317966186577802177901765723853084898655523806749757743392446392077019937852006170397878579545875464310845267964255584692120549040323236066024646928678133185772700866757479052643548349814772608087589947205732549932555220346767086851072995082043923163450204496209736573051652226993135716907681245265191491472492738226332886207660600085318807396721794403483236499202454577325908424535264456446633853123117247695098788395868425099610113106977281999509043742251192130008000709013459571016623642365510955247597494398204489872544337967176092206804584554258973507432663601773722658400688751962599350084610024851185909655603299085507289759808641324769414523357375637656806887432182388909378394387253679266615502515168714809756903775807277900616991938009845595324731979528921182058240140038545339284777825557370459022623314342759252945310791708159747427273591885282936200909965734898834102119459452811260702449475196552681049973300210071646582995943646904886126353790900964347909410144869023250540083511628319953647914770777522014667364316849500648177547083025856122321482785499122567472774207188372313469828657226868182348709472953493504533296936051981599139996146047709598621350326179274070588529062594851773943992066691154194609907524318336384139338746592718283996033264078052542801651172130009400328339594426475244022606187059219043179086736710580576190306491639549365512562334170558296410267149193980496870607589466073782596609723968026014625012813149307721459944671340167367984323646151690021759414577136416735545915343352086244154348395915657196906831557418458515168619253356638644142894876555317126200949309364024182650655282412995029528641706417984084215507703766302007820211969972943339322020117246578971235945827694701352352409442853120379823496420204069963113933161781587067928544627049510066727217511786170011032049898786875461522335902211576263096908185540719665854449825734903037433303338293496041276065361038093793775987896698151087370796200023607251251457828251254139444445744219305921373742942409122864051007397230942450096778437752569655719614933511721275663163540183400889169285567790803436835466820379820566353740765060025101286749535127687192467201308139456622346507423912210322052429595436915170289198102990230026742725973343682205744139438232863867868741694642428957892377135516495986727901898281225525131906996179285268808836201916778425555051058178058085742273711929796596420470926995204875702866289465915309679311195164823953698144816383823091550135133884398854303873182759820408232440148431576212877401847320835315248918622498259721196991962882705729785242652259131548113365632785600467039634054196311672101684305468049154017662993287009628165977387873173139582074585417392599166959114883973019997986665869819095385997151000848785393480524693431565515167501357002468893376816121283976987406208125276344090140410083860105798528789688258296717115354770841533916111178348500931511063684443301000405094872898174721249021780376721284501377800312588333674027422661452864129036320141380359229615255778515178655292326845943590959954678627672284174076794152932524383584961973754230282643652626451218539665696787598645487996339757223086724575281029514079841740152474932598414115762827818179146087557457486730128767715190549379389603845307857053950626805459814294538064505053797782718727626065199939621776913929103615792956997494374006100144394729980450117546440412039450507241824418681726779060254058534594249432301544971015563345696638969011382350263253441411974002490728474023851338398135177892394144782818839190160864528559172175165035470731877552235135506545281180638365038381526695447881891270849744867815997359335233797526840375826318938417632291554456959076605814899510409240984825633059518189984612577591259366654037663386120220617094340902729962458815772604156774233858169359004057403183898825057415827960754927418999413517762339111201136697272834210689908177574280095474013667304785459997935750096854985890665185629841237846225912385882141657594338517508079334002246273465943283882321040537969258045656641000732499481642595881335971083359233970342800478491523811452244962452957527804095720031843482251374917473186679024919109205858246247015623616604920684661551775793613783158194070020208705594467649703090529462305943425038044310156718789508929180604785244755392168104662050591749421695915738611061775762866215050756698791418178461223774620440799105544778161516457212770569360463023836918875717623417198440283003883375961391358478545017959665350427755964921979471226765595218090919916324146056657717516915500930334667588351378978728729739310347453228785166264678138642746127965684709038158335149883190437561321546648961770254388200061997502440580883306618618286787447208257723765139002884139066460490503933504813299069151186179460382519809622642257333843143905587958041162359635191549063025173105873219608506140381690610496240567790278477054694491388357018112722257430917818157068781055512482417794313429709527193062290593751863735761791088702984751963204615840254299431019562039070094133043026128125701109927248078533671997810127720801433066673598124565784704240135740809483934426279012728829071757891185413966902617612446705411752000217243916768063020817120973299028418614883072301329360203696025854875818344996017474323614459349581891650040482582467245505197707149814731455372911976136906457027726251422903703521685599341507165727261467513098992504316951983931407964295790972967940705893761915297016188584143100450226692331741100951096862133516224522233157767096114972196240913476489190658692318030258298729143465511537389527726517777395747544472521909308800322997812911232419051902683839480864456453387656225798054210474812527521061531933254375592286236977921681696458202502175766546517009927678548125269616273286687833856913530120109079455945654473716473106700093392674344340089193203995608580968998794332635502215291418428878874503457780161265531631038178623444668600618614378151461305708947428638338629171208132445462898383741118605659546314614507678281743123159934185309500831113444964442276963627968965427083479393581442353213334172307195746798559527315026065301296485609558433652045904051136817010073147377051212630273366386096096045125615805610524124909550258940932336473365800746364448233065165064847183005080259147139992321349940347811203801096067848603496210839275616739381158598416640484339252190993163204119155712532573252678636807096938661871091413830754981427288195907717361090913963827150474443056924533008763720739598854149780863574257090208827043633537626919633088830250758440640674103305152423189976309097206332646620511757333116030793362827115915981629346051333160865989306320934600865939542403957488987221398499945753291454159103424881336005447437181617018926954650625081465952557048666994370343137231462176023685698597610995711049343710836113865762761841744162508468275328466770857526617486351538909318942882938942713053912330258861987873271818978211818980169282165876717644195833704044260552123107946770736877051516920064772330472201908233078773652564661736622060731826969936428651457308971213891825376483505713500462956599664245623285441917864844090474704746606332426132039041987731737102508458344405857297105352419493507776435009133429835509938685430017534540129806712899895452870497351015295638859838156474731846064530919034260623069065511636325236635567928015023666440568342853648499087270384368785581212832775863836887109416269138578963910232935730034236697412543188643302433128469570485227592410862046063479162368424662946390094515989389437748396322662891715997639508753591176056681425455560508157480497344956033604314066922997323633356899269205334608960293655115910743477304428049188290300326750764205757906469464074343102191352646826186161566707657698798096174576454493398061495890503769443300638846830873512241847216921936161954184808230250300810579285945065099811037067537053085207480856316257584886006482670999259434795944710896371385079827483398463723173393461396920525425533820252965321595219375321058290460808026232315121447066606193710564602865100799125248341630638072798872777091955811602040891408704801606931418322406467629449874662291190834521765518841769652891394092630558461121812172216466144417836542476628543403065623989524936173880691859746023049496404122132746871444131353848853929467771162004106131023317586512433118867465743671846262775921662571334697211064531930929098356365630735573263989286411248962526903837485751543637760592379449665063771669367607359532359925945838401429259613189766307973935965021245196944337559051433135774355535899361901770993170725248858435421646417751617694078300875810891416733318696200499104737467306373102513159822866585384513534266740602204157362148903454563946161292876375937214938256470733259755848641820103622941281360008848507909575229864077720577555705185306333784905600320025587792545613038092186848752809501655702825777755154670017992713959824070900894310742361495760485618764454265721538734279355143355365737530869434624762680030506592960532188200266517823314668407648236257519515157807060018384702371825671237458708747322895623233567988312173984439108641440928239610579769527264888998305085489660306717709711396552673498688310252359769970728355853407313442989235504081384044998400878934924378136122098215134443493299206965489406414873160763524927678095012246243592673988981083850259372425737287419390849858758445840853482162633697604962119823460743722042916571848230469427246865094230815048870297521788508655437881950649873832762473209491674080290427403260596179988417288685022216250971997121628302879048282756577703383037306405687742421031527143957425105319399353757636665024578906575383558285858773669676677471260214396138442399404473698008840997929894091142230270328733449239961147675676061109074212698414472295981987711299849607920653030987536441703602429594448210731995034968050115797893016706425506706714628367370143765239829218668735212525182302155215609421482651216914424165663233039771245170403359758339468541341136954549823103797422359673089959508579762956943694066145521639146825553586381354733757632455350200510028414643093313197542808539185864111991307684718199129431217371116476567069626721918990084092239015839348192372683591415741303194657498611308546647781118664380806670653473773671059637805313173748833190249204460151015896307162666502210305652696328454680217877190152241004282191516636312915934061401456909849079657086667475936546344588618307700736153017495306589886257806086645749580588016019426402338072375120254574057622471886454217589285438515819898608282183165990745629606505999006147370375868244537200647499706744002044154959604487261983819765319045845225073361644367726490281554954949636678657092998740789744140407090965600239392431137888499106597382142736961970273701638608318772282501618550856469355010379497926880975213295717204438196080109740685522882135146728664450067489316226965435425686377577273263688729729144197692612915431616293652669407981322127269086683279445162114519177279857795669317948593916822794021680405337442491336693961362875729754307750258627925096640718588931866142777803693127651928433110445946708665617847357762137495013606442928189007035258985373439013713289371004222766950909349747661890866030123724953751047641999783210220351237678705817011331158007968827902258534883659768215488968667804000668088083126344838572679035723327648089627265532627811819188589052439913685605894814729397894697744737583279997477436687417959309230135741991500338315608142235008705185095637133342499101287949746855526843304595392069770645788452150533611471179816361970683954296928093723842508188612412878665172973010284406866812023099296343047261677944414628422174988758767206431089317215113782077053303511842420193383555239705124214252340920377858394376800362464849539674731424462448932387056309398283876346236532090798053917538879029634451969159763716737124212798002518256561974281315980860221199590183422468001689120653543619648268867653659085422121167412955552394833365718179031280291421280407045048139957765145674054021788452198713593631151980355444489130530756706079406407516034262584599800551429265556266262323059815658467126144177463132414982605972264479064988658232815787312051101870701522813229201941922061730574866586322111103666650869739433616921630199521370559736631656255680302215420352768858223204622800704094709610796270789027527301853956153906022968739919685584118191279375689763364657556935467179290125902492332966363119798913741570620191272850919772207588723964361294841621368881108269779500322808319603856754306426476820982571438207131654228231187892293685102966254656665322455980457335908915198380552225369268857066554568120757078514515135182736595648005261193234277385734081826382444556304853119213424415713592089996109366448057356325732639770376739456167101357741922104418582286543978425904873663411749558853957093815022141476723364099046314693743684500279559700544251993350203331506170157567898685518410080088640819386050501570993761499412479395127562666446434846231413117079246394338921702582622983010106798993841669299274298389039836128503324608359480597878042632580773112078064668328299349070012041577006684114028987017046518583924141848772829181530172602014018155311218132841170611508462947942894507906527753886592677602120497054072589095275114865345171571964077826360237163494478063607340831499373967858346825673270531094934907347469375460184502871810079369918842571384752929794619975420196597419110578888864204425743380051221406135824614849829783504406854468917120847998248059365389443331226811899791673451698133750191011260777585996327424033303734272593959070334997691210985905560306285458915211584598391736750446679816441523911971575144167647058954565016076412793909259005282091563121122089128277197571936236137561607110872035592697014301492357214304026061661138966525275659146584936647460823460512188171375305827177134321761277066298162410136431536582537991467401030197180466479755961098552248489759509950984721788355780912213689735845268627685082525288091803821649164104919380881869536320019162422371065035201021988545085883001718456566277040839824734706908666518701687178762018267300940674106984889161678200086575946707303017563309396485011207464507447380776098559298799903512700771166199900909650031015783785724328865498308866813600469337663850668054765940861950286678084365766663895520768588445753437057362791362570683813825763319594347191960166927569123738600290206349721732020889597268103641706455326293860046271052019003401496676898885128254718491982478972487864967081775862650009441228155421384602436737755226820441312940984831585041566146836771599148270811896536018521285558653497391162410284494454552468231075278453111886808732139413906552613858200667290949125762191377606399000591615774657423251250124535046668796221980150274323102422315388983852087829267665755714317806456233135528685355039014402290693098891206635540127896445806291466493837557337710310614469309238962751148873163626813317886500812091092549232402536649240323277933365325807907080495572174515446573431806744300284973723676097488691662854519435686056983666755117516562713700183541278820430031485607597302474262936722362273681243875703111314767912045984190668387512866518080535198963400113635935273472997532492441798996448906888050984797959304184596811858305698139074829097957959280148653713664120138124516704419044128312819479980063073478493909058791659858501722121461408300937468512190410173152156161605655997586394678554539137473701304617380878155349918628840306158308968128821584036779472469108776911399277012547762837025228648273829044252002881054066721405357310724838648474975825000024984417402170352052487486096971536079701081209317115872043798167714148918344635962394518681124426303190633389688918246760385156430514050019367827359447647502644264325384159456384841732156524436697234957204828061378522460453954939738479361873749700662191631303970836617852157762549033724147056503220351022981944882920995291141697419491424023465234016913855681066176734462709246508874364355290752774320290425831456938103190482445753895505442602347571622801231118098723876941000996912418700695657895321291798712706637092977166104839318780059669128639914004898823528328843999048181754977695132318043723705561607566937421379791308388494531360505175810983804135072378386844929096301147642960509459766335177683619560559469324355638059422603279163121779656816643725514932907118430526758559363993746429632777286335497123815334048584385860617752925106621292605173760510805731056993159013081164181301813377776648713352218713249394256196454200343502571191549871595553697167452182013122358361086381442930140702202210070592046915454226014944358980352471288965409185269306441635759921245911137049768169856216681781133059508709780524219846450306925482830365366112903027198658561488946472217813034924642859669235829485022451167065055171869730409404921101446191710056807413972853120484922884389883694593488961554117874034316397653871186094671892257200817737795371646539173373588582533070134834935389851255650930037629934468415682241705515154047087513104505651934350979487346059388162698948037278360776291996061632886471447478970137688331362059438621380755293497772097171638668999811734006769044277755127223483053682021974512559456930437584543193839798793196874486506836669259985024417839075610148521759524277699722901198855587555565363780391807491070084759950421970859175655703295868636304472131831579019265448833651912634262439274824019810145276705549291955117684434787180776197963310194957582077815203464778727507883925103713431452185319515205162544787631923702901215149022723945740626418983030430849817560051343383210163955857384447045271461263773940334501246338719931899196007345716385031352843258195657276780964740453203196187066732642920872305236131646266770127327436978750620342632189103112484401883155676876469005864049653604907479725768837581309633590927678949389395709955270217364119083492868628989354237887841487014700574925115471658787707667732132595179931902762540138087873682591186602565726928877280460004565891888250448296690657886891740640064878468937225703200136195543773405897915059483369453957298906051042455388748115443922712065145772858859125852808453487025987228256206347041631694399279738801676491080256167205249154901142696856639035701700591723617599505629253723503242783630720460013275664383612338169146558518964959474507383555653164113523656958304423954305958839040433900003429124365834212063453679986085933600115026726987276425339136045244189914566720565330742700800163539676645384158524453902121798181106856664592281545615717428711781431717059587840271644553846804725700216557934850656575047622409139646554678518324698896546478778338836605792199165097411077055047055407167247958456599095305570996922291572016552226550885956016639930351521767214444080171197524683387988650751633093581994702356736747854291405104792495845044929129440642602808322257114315824408815064225730086291528677548951207229726692413484453457683703278939108417303975535629424859857544639082116207806065338944366998379118560027012164080208091118581260470001279755113840151990648298995974198934759135118494916292670011223638356507812440313327047278106714799091424117937558484850300574402692374770277220301008778571704642030051789572742860597411616961707358483852020357625964209441154013626956305891309177622027094310301362004265989138673858867048739811357385218019477576156931884636992930747906447122783146298021001452146077360094140617240847301054431786320695365194701154405842093749211165683094966079418755906132805465801982888808171611431663501161100627970826058449077219676953005795806247628681003111271754631861934096825869254943449782745793244641972838267361398983552763702542384580370816231168233303557341539351198801699598934262061815596771611628616642901894770780759989193089694385875109495644552710566866842576215684456564576756647323179535376562910530973956601863715029025219078103772898375508751582894843263059916696372582406793856460114852241519275534216434671462847161135005933096489305441241470970117312519179296697526029778157980627679798822272835089571770661318468680225732418215269777021837676566541485937617979801259984755977015169341038755382881185636778685166539675998088318440367426232291443901231401385597307891974552049072580458331552357901147260261418828359582707875084765815201730161337764219035080579611830188658446689411611679986613253506679585701672972686601790409521566048166807230401054133969304648508774193850532459057443793166656309941542639562170227651412558215146970514823811884901320245267478230192715290526325463006814540888531261134351925982447293368254079821488228140396422097729468374375271951520274484320685179280768461892364996294554482775383910911288526245167523388776042481030639302867905457031709938799717581768446564117355818311784512835488783990745726600074741762302726881490419273487755471614822161241364673180853123178202128078301882622452307257381837212432222252456345510593822647949569807974937814571177603313955809908401922546127592976418812377418097424337478360845596886122726012649666545347248000124771729154632692340812997423033008194309103800539680512649313568677809360656575833963459309764814166620381480811740254717504970964386038394413001025783382100911110021321773464050921519016831964255508908869281504285086746168886309765355118369946253797296948695996325436923310567338677512853118542969380944636263428678236925005529250601686247262161121832283031268471668790554904144266510691975946134540740046964731085841954887610913541127720733326062483515508581077768341205867175472552982454090957145952744134962504139764794802324071936759892552251335292237218767187208481618110646510688724142420196031781943868509125052287575780007996613181906697271932520808995384460021136942628213526869305417374177335738473176307124222562489718110775245452426294305182465296120862453146300815949902032628980221110178429668425592534125217259337417278157403332061885427526940872463969746780482562206642238305331572706156030338331389866335544588620830459660933502558845884858412511253667619046216456535511868980146746765296910498410102796744271495514786127752510610498583814394117094254420053942549051594167275219295554527880155577630815252688321609707685284916305301870253251991842293363707436047775253233873583965707065132138802928961947984220532394780125239076746754265075504263980198019670987478494910541212424514806719939751534726588444093450427477084516492910508603943669884437927864437328115847328392057345014179207399144494623249334575986872200864356250243289595697823702672291484417754304259999990464824842639990974679215425063395730107152301095894327244479714788339822503195053078514529665240114482426503737789650658640346492654534030618596439863064387394422067360191343735728710341871761852478675860844212220449757048525822185828233617346036129140734388077459079514791908882507628475408301548938701807770701243351631470900786431498286649733928755635469833604731376894185842821503496571480708949096039838277336420212437094857611840334014984700908212515740239952770532862695874813305548532132030994384203495965330827192922041027514897119028266778872833042695234214972773275541869033305529768460270395786334625691503252224155846230205690837291289844067173854284406200548465718753176572793677964201645265238305058197816658539775027388725330424522686412685507475600393854978361022166957531780489660422704945231388480628284203542555796478685742321044307607346833996487910930904045131745887716870490350537552028644993939823341071532864268886702615610053026929810087672038902763524821635036701804982066776954772098227347101158039449143956237718211700474862767195472980690696638723970369584217064542647143266436321149686191801962893598677614849862315911260586590790407623124736817998820080630399639739936038729029404762731453235293358691064814322677981760722241122593973461453037267854591133370001378217198110279747475128202979948143698930658265964391108158231171774824364026978726235154494840952622043987932002056304482727770629451619859733954953836689311196023744455535075792926000263058139397062521419272098397449121678088412541046390147544908979609100201504740485607645664967533135838028749721043561404984065989599564865183530457331828561863917614534116067256638029940411559963580361044676008752101016357304717003739227475284076105953836301210206456512097201847284351697477026035260844255886057008048182852786812627073522081589376048855301278267299082565680828589370675839565527412676988254275369224386637433086862897749864600096621155230825731989778970556314624487039578314299145489178120121273677587384553456859946971882186018712598631684383684771448361842635420579531463217227170312249195707344409421664751926755335068696577671959600268430043067157083829551979745957577365008218314669910273477688550356784151554768905249401852982739439794057519306865222377975866616976917231597627810805604491675354017509832968013666737185446295792712557763510564363787620682209970414362392436141031109755885984895683136864751366705331712249503822245016659287840313684220217153754532668242999765140731215047986434623353140452849913225895487633020900149493303185153175182808120971558276477130407376866011222466599596556927595503953063025671495986830266797190898842750706781265979194646864502196892412179087577492690050064157001854217244226970931155894770692074509198496185331995623409122627014901763722592678170867493227566776041120490256513132505791206819995271575442686559877532803594078206399058861566645753339411839670920100097312218201685709422920513565987001014161628816950243257021728228688440359168400514025137698196966609790292362454900969900221447408721418748906044210035311613404081756392673609179046037530230773874349704780088246658703495176680242882523182440294467682585134875402213985324104618687990621095084034217925800824932265403245054358514585411415879052237699876649369332491759401064364518307541698770190326684886693975744846055531976456970995663898891394267077309907755043487148731674792069456070481017423172634977888243121775712495299106249437755612321279860354493365246652517643204987571720083700992326058186950107363170072396628384133036534271587318507074966879055308093536326521802815143335832103248224084148888927641331176936722502169298343072889578402487394362045348811724362631742785818099238597289288122039074421179295219340584058543440916741134302296006111645899204863915507869990790274706735713543007210345829859759492334518573770259441310097860884326006200362751824836580294212850332656072049107721159444150041723648717077238577377347766697179939575303635331212576122603787972843669174807569767534880275479874433273545707808526270929763698419768729075381000098134804435603587064193143346191949311662180227187868998155719081281972774479263338573322119487611718922899927555963807297619933091804997849345637743263951264856979480572723841401183434754311297563259044525179235560943819791079589518346118940106391448243649145818427462616460707293779306641466583019801155543548670676048405917695130715447641480033019062788313165814540152488388482114389337339801818474956136505346809808822209328834670006455442826783243555495452875474083441889674402242156248678832515972563455617521723537380461370904833969335446909880253998186165670040033356035332523188755124025751083758421687611742921841075646974162751310602050465657312865107449157308419542345062054585008110448248920417886616451182953984691207051506886589691048956738563249627983721602423079128083635489641662527011170965402579093379908245558648440896059429515613060828267230067540766446564094558905974021608315011730610096410062436598160712574639867128504583161933596670406044108829702871292875851818616341807172342792564182878363091762103548725375382040317332055219481968303353252001808799190158842023199035876326011522713288661957839840281597581608851053725558251806914926670253051961197646490101327805295133786484551420883062187465636529377408268979488934018814811284048462117966279093465732020524421066647091576292622331880838109784251489970557447769342451167266613087492253676336607864056267886337462260318341298840137579449218094192690056869739214688176142457023755466559886273566451035210026409968572746651615847756093623965584363406030592742337005288607772706451982521157618321505652433699886780862843163953927987170354268722692392904519050992279657311551851443347694041833462558286489812635865887074497346356284775318720492858174305592076284667895723412316104137490895202373977758186754486311861050976787667199963833835189306317074009470020607666477632398232031586668437554551914639703351314625854511819707077296762785505424821770126106822209605177306412313780607891656383173047174489259444877209158865545261230473196929900680064029507406767254257946041002150688196798225530190424816120291174692198793966931738224370876348967947860125330003823186200253758202139462536541597203487826504649587184623765093577315461465582315373551815174330989332182419572685737392310347899779841834986159043360071097223785573700581223549235865666525286384104050733821806846494660200028644520661657063879616231760425982792877980152135920018211294292142125495450338068963632568606637080501543482746911569572009960650254322326520897221371143884040843530559690714839859657344324015057023679160308889476076795910170347062642537112532804416064835381725551226415648088736394022485715674843675931528820965587228960398518038247870524321404490195486218613067007614687071274530291344181849628261870868361720683854875352662188612856181324240166484880342472700184194198485958106576371794826950873266319448508413590639233021549575791014484150516097639672670735601678442925616235026543533455707097077464849425859917377505890727686853237257390857321570419990803731889229739825670291596603926008426703923755600857895071109782229556284588405058786052907396375840592033741033263910129761764717090700147571745553033268019135799657897212803967269469080839705072792382256391812836278033005729856795301281213547987167557620477627231588766514445339321870270865379778874668811096359091687480723921900851312027831672656071684683160225593101226918091983761866338525753559911821590187082170060710215219578605976842926272559801635557916902431377990127419221189091785152376968526622515843692893318286989017299976587465274156608250077148008500091553566796848472349978348346682440154101908831556151233797875574164611788078607755545234512557014479755864211641184757659054212466036629027837653509597721981575876533073724339157173027458672561522048185678446883255434171950673009490578326835260824766991360717510838185212552953701710664876471058731452792378621863997851395294539597664963141731132859211494925940843791210328769118050946305712352816291992408188632983089344969407823678245324688435032319474161986863566329497050650076021466418977109820534020047624625037616785599251901252120498427846158264124514344107629312622922239384555892593968938578892709161987665065961114911697482534362185148024740332094141968621390898164785483992150609113978995985397233854837673633171013336126310545171382504703980982647054545456455984134267990937346169279822275954698755757664346953419616889359101824622522346904196802317094911091894968247500592130178191260694295093369147251409028221140885448782090660377904557459534344261352949080787180500580933476752267110733689076581790861472159774362185837446701272018562612196328139064161363838530029286670732242878281302295142448896314185438380243362353407455946953191644299952500335024456393972062706047070146897302860843527935641208494397150668370822700203573063552143170043013170906033338452636442035089864255304357708424705475648533156649869821898815072767524704443424652122693827991185805742793784678928550773577425983377451623491547358609366359466810965505300733141042825237228574487658848628376266310450405576685449565166837098813687699856370618799970367089709598931177484023210076796863602079602587463768886972683079065693927258346171728230927018328880489372623053550120757107562434017908747503346413659846082518772276583056772642536949523267583080091728221680781755962513404476168152040572462819423493843294965135292088523195930253283585653951327304916369463192019168151374164066533245754152439088522334872518490294948729797090311671682938277698989702160955116528492333043916721205106018965395597959160756213441923035945259355477553224871405166305893760483407235375232017712853403956800416675394589549775558777122022699465945319410268510565148840241954043949771950788218236236586719594377462158189745881449736697893772010132159169498807978395871646082380866788240509529141604610217349250363043296862092639888593476135926925141616026436907103052122354642895640705717777022746487969868350691923552169166044052721852053606588579604273136343147192375823275650036543816704037656784214899794385216228556642384401259907043158404820998923375424320606349573635976658486933496415592176206443351282675779329784673385168841771483187881782946808665014975042393525037969003612021250921990991931612505446413189933359545189114581339118947420507181765923098121663970399815296077416652248344945346850415986731332590278662934805744528714129249632334487469326843394852137553005358703213346253438104493339002667852193229419294841910611193831445512118286289497393675820770490968197176107280914799012009537946175340319526269798581621700706731944593370678751446191904959411577810909886806662878114967401595714406367067942811967879632198441728104922479449672989549788944083081093887070942686470108208058032717045173922250829564733705898230018374009698010368627554377109083791463869901723941852692262285720885001996842437007841129811128607809228723032745174870418105544644797710899712708506285640091954660747644175409118446737310418268230503331496127387593251347223295724760193043901955418130565242581857790900233836428379216150662272530297048750638439206683453983549024996871433156664499028363517520291786192851870950801010245989373546305039911539248304326682763343027094815901585957259991977454345406007900544717599666662917301075762692497651718912676367443656339057568540971280045300008417093440675253248182450237244011100085454558417962128367444896597579670165730216650886676526604671173960543441574086163255337640998119573055680483422087419067094821518950819104890780877117557683670122358699549646751374899300298533362626060961528524076588224511078533200467545807550327221767453804996154702732283316817918232772807882048499948127884341740247480326536254457646991132208695560875319040178232578798937222773262319164013918234233743487412536132004523596184078517738338882499538049265180637440694315280295693018214358861376367157891757937012397338854326506426741935006699978518568879344318214570910681161210763448181036342585568807542282057177198552966659453919353518424840336367460640985680443995780125291065506935556696657682824980745294866938007738048528775218360462905557768768553870246051933784096147639194402806435984602510594078483822891194186567787703273328160774037241763260472044277270072691009759242712779050103031507789906646261315323437040452382078230720410005195175606478521051985617821083554644722606567534207715343413793487192862990250224304292634310467473551571018359451876798454241416845753356452486170242242485904146931834615256600014951205773749118630767943300347016741609647425289957685927006343817704166020330995034449759803158658686184304198651006636897199126099636889792698933919556098947275508383090246625874430846170835999974146290249439715749676996437275120518723746035868859485880085357295728798475267432366371377221845262312822739039605459946767644705232704406869764139403399654281242757807252105045438403276287052945067554457883271529440583786593115994199205103316808541093127250658225574429164292236528171634407983328619348494569633522251633283267367743807076580701971958117351649745984744404782016121380248163827617573463202421370752821404081220382774390282451826896602786272061521357038262355912961180679457978472700338549869033242984776108301777009221805395771830183363112236678093591879101756480372328610783322154331802722996607334374731510090367739590666128615959224422377548593705867973827574640857735132528604972121775777393911805888319999941774412363336053133339563837536463937571607684926327296860362488187170573145561628798283205031151586289828298934957668389968526517555644454841339330983195870815887363749914640496851883828085282459126666733608023724197495803805164230678250316013310342999616715328649725421852646066341562157064947901657335831480987133246149164680928803395115158405931548404015240699827208496384715821758371322318542914512060423383759950364891789815308495400490738897918061288759897451001341427980145379129233519838741316516354658295542183066850419842454923179897679199414296345884357188600138792523762722451799688895226590337204749229535488687869051427235819222088538990959043026202269439423957313687963523885869645016687238984429392180378779586576566110503285812329160942304315565254581039286791699412108846184822630516768733435217493464805946267588916410947818434424295141316068899678853438851625385879417703913017181470089529321793204225014909458074405555154051137824623573889719252690963050018397936467264906778386006006246690790834458587747242214748930371722818463766387903660055379081979418168953608669163141598454240290631497771095635039497954180820645505786993105028378104010276359322195877063884880784430330861157124616951868032018374004982379666254366481883021597424151502554036947907609501873555078151031841506485007093288231783871027186458665362794019982994079891047218595521990040341948106179030442927040377722673178446451756582699723041359299307089498867581769872657793719651842059682764861497007327709703854897523996036412376705301585892200053692967759644908799935280450518025805630466113764970259861167252582888500506379244578191892161687482303709474915910129523118849347535402402504396474649724490582012948966035782034655671963916599796541574716840357211443139119710016751710572489934694272640604903289038457858874721232998578487780017365332841416637959570296145300103809233305112139276751704547765576694265980990282237117395049564542508840536837016328636645295061383696889515880908907228762590421821666954501362525225625568043890777189398100815442061921216875569358342856561216197294366451605706884848334895953063590113485548336895416961061143357193048272966859520535029218999455393544175951877549567543750103467035558239254603391566597168993049742509976081643510115205228063795152814102177500811516596706301116103850720501430670170421178899683367844758154029428980986122143096591439688707720921522995584505287278401035656687948449920001491187530202354190866074360285611149227137130029981289931508804791191608843266072579929489161128386100804173574370142323915677996948329768674773693400508985418346855034499022605592086204335767065725983480366903440405627779007336050917935090824721385044887268581905469253044587478698771416305353161970910744660830448762070320584786934424471261444684123930676228537256829466114490451118631001950524600170932961168042606192058674393788416603508362698323029709201443410692376949875652918536307555854498808885882105135134305363040051752141525893868987416293577755419957469410230485354869608764587676328751138840606427095722173886383560128749136056919356105967934063860205879856754164984731795839667371309367059477685337218208560175531091969586879737526749575265684535266924107439723307029397243874862752153542625247309609850959967394678348072186168590391516660450831809594342022033802810638769593294980252123508625867963989393423955493623241559227330876402092886237244384659369589249611819449130622001829236267508903590735714719899399194360443952798827311616595528781062936166240626746076078635274278907494000552375665884300629547426990994089682052586481680548096933295093842350901666261698017701809643767799220368317122835232298937897288435188902920284417803500994956185506702203694591773845220230511801224860604931488417454711780134933870224528026368241364505968506901667985918453196776050247891973356224276831768562388449620092710330684362528626878066086904829090638896299997865285196991748846982300616061109661857734325734203966487752741512973106248994146319152298640501585529416252677060456400434699600931092897804279037680526060389988324143700554893640543509212915364083365760525872135898300775278292785840109812267200897832053296171667704167347817629593153402012878722555477899144746906153053220659352279977670759331864800146792191771713842723224223157564685093448137739180382110122473252460535747105568805340114440083008189845018797225688736335207915906128156459953168063024069860430942781141017920563977025728563481655047299242065502191356627141520960993005030369201080712813823065465053155511012390309250245655754819146084251541276824134175143756296516699165453849799661387708307088560582826173951058014933535770713599646875902784324551611031383762810753937613107534195841231800871543819102320024368932096722387675210250642428086194278354934026417561128867646145949256951866220052143955069780445121829640229852594304367335707299567776009638303975695004835928559440168719692933089677655816738219489102598187319399448725408975267006681729108925273885779953975670759188961393448605010653812812969663581472404145225354112402275387142861324775044103219380700239080767092764210475778205851728074807544697184498953266457578276594165698731004271282141223029925687592785309146101746776354320903345292290161821037380490386468379844409926119785607027304131672828744137777916262310327888071598503827024899735984973565111916520111289745077420944433395291943109524098511426445372869565257385388492908266351815496017986393539964712602139143866444019821932374525488794947941157409535277967898141041996252784645227236575804869936326594303019459248808468843980520334202534591069625107831877407745517789165021178034361285909815402333892446616914904342228741660735026042885412215863173324634018318021541162443380699098185339443227471213408662748468768574435264940367614510751401732387846066695451996717759084940227285293860137380950739019416453222803408352201121426725076817366154896719282301327433575321080743909010746734564028910773797655750305502031959532475687538101335626625114435190017817031015843248669127540216929411571526502062879101901220713979428714222350355525120798980836485825801573333454253857035653503345000887426042293478801906618760879887177935887345804246066555012141874965227354443152123807051146667596913031723721611593665046309854595033671248478810680901217668945419576992566835935546324467581670131385119921864021984170823747118360863084859571947720766306911839387589580515091331800894588093151031387846498668013338295107355393184063449317073044687075923525611358839600150176931943754180918978278075342576184840085843499708822419414098917018727197478360411902726685729043122545655741654140759273268683833732201920576839271783197557045046807885474733436101778690164803856687596624456892200884542460475406377262162136314425942155651503880873498196569346866719325622758862246954941463255178499484671183361306053859012671828095395835961613921134734335223556397596101969087028392835555174058755078345444071336724886448312764071852238023103811830263011324469458519553158332438979167186589444479036478791118697968736928980235790081492775618641046965537882764620650155553616569783864097593457070201270286163761314934199612655455863943563536047079649854034066218998588800639795431274732780553378287118297567401128709110329469961964312068671081605868366995438380033760971552294173924842658140623496680548814584493261245820824862217227920163101562296450839689478894211205848716002392157549239181748387152233731286499544334418399190661569069961951045088084747132510496000392345393277906993258772153649655368421409797937434896877478638255428349429888253493569425134320525027500961099290637865541897973065075103422864718377804676415667021457623784482711069499103685947013430698028311812177861623309538268576866548503801211206771910558181313033808542600419452815121306467322692765812424645602163736667969454808584999095613078550811558211558314705022101766794018690131750866188814273884769615951097195062411702274956247257843644704800985172498262335589785718708979152034045951029914093794764205540727664512338713577069840764430791626006886950862980442034254772492269909052330196212551853784096418535248778459179157472998108345038765362435276502116000381116060580834663751245904810617816060821688219048701604898193503552815904063961093729849643037029421538740941133583227026656127304620681099889400635181802384247579704587605483646844774019354898226932910627128300853052113593126564256384284930874860832074796024293313444734363920825151541351575680056861786386394657686015111394253188397358467243461222548642296311034846391903944939509881389788039496081066298983594911032919504580122332832013721620231310267756860873843057721628728169570918311747428114101456338031350573824842582328585450767147856045794239781443123247754642029918062513348814557428597423985356130534651078301549304843826329170015294978602828805409364260769433535993128908363746561876677581394384799376710591269336694360935169689187565298601085178112331181850136950843465129397483577867087949072404628634240531188190711012296735014648562790171904951481497922135892472308266050653540433901137817699802919166522900261193899222241719709504926931058635685660684696524121627680282265967679568251345254146036492595214247334749663894481589686388709023582502108545067380189482432634803706086325046574482547105308616293644269443930652217595593685623325633028067184910698537992983440345455877340772894551732051367301901746101226096603116313361939811791190996131424084355463533526643910858565012543858827851764838676317231475182066394735198212924190736041899721729898736796569117376247304108016830189866028711122765355825455244895115414723504996985714628463435188797526378582563406870792429799244884254802462447377182525689786120165406808441122825277069051940379378905935660162780454029197679580867246358542733576126438593253792058002644185345592174503615610480530203412004063564770042880866299467853818303333438127486046227673876432121195027210854793015609215044493311830742857363333615597749811192886226580642649467261264732841352967126311625116251552865198708822788835718532803143623732656330042838911329120606897792720802868236353912080670884800602780489457156812967022691576274428249140516349208220074623612889807586761165153069555699521464233461866568840228329754450703098767315366023588778286694191201993730728917476492804480882549189352832545714356421448878531163083998788430154080855136295895633885262158060124712102290688938752905314432445790390092658248281413280445691492309254626476436330791339055765663127106671354414621483817713867640745597393519487602653002024924674277354255053238951356652595986005173673474026148411177334562607527120614235985003759925231051871632006403504815477879617856449281571703734362022923164049175246674090623209037018330333518885915584389750473150727258098752962665884547110648956625976934974131905073990981702163277969654173433894417053494221791051020980563088972300467645815216822522677662361214490331682195667554328893389648650731357573526433791624674441592456460636079869086378150894850293494364534877630455296448436364709657699599044933039015057142268350267381807437284657517400720340848356473880151653190426236162306360802987639834931355674613526962140499877813927202907062079945088134773073211885373552859373914190224520706604350374914620872524838637068187835019111465320646286760237841266143818341826698145576583429728270060474055611107742247655266315751201650743714274056493251338008752358383570622250508902861298611065859062661773985948370857283624356826766633377086456405030945777837641014684133396038104987122026588248397894490996411061556074934165543099695210290753261133264598045812220544778086262790200988035282770134238163661938409681509260570937645625835531832295866801408255235414990408601715399897980914536823044089383338084739090905733836385269261748536726447513456918065216991035878243678345176081726007984871130455920920871400829988146703238061075094190571136475872030216950238619008354698980024902091604978344346718185075795510641337662236056369121530254140496208634479047185260982739456819618543241687590884756099027231160929589469101942624507209133674453163275242948846095928539971212233877518284751430603691332625515917626035495158378964028958966032181045807459575493051279282658864015450719329124106756087229534684649933636908775207541725643417779224986971614558939715755550697885851355859217659224324653577988179774154800843482529138810081121090003621206242884697010099030582332742822164161219000578414367480420747937638213952740598983340150555288870250797903868186448784426741819058120607536538298650489064932008027150799528531041272711636572914336099609133932523683052070139671631442699285777559823823915161069818709318895787730803190857685956872735569547497920085585254739312644765081782008322112809182244915637977121285384486123732583948376130695001865415015942997561816586323544355515707477048234322746473266072092651686881827086525712114474849062382516062870517457255033897852893804484039101078044731234394309160826110516869703098727097687259504348590113327073862585934988247253843028073252150808575844611479100651907872749585865032181336712017515635672013514581660120291699952866522676063658945268424327693599663730652272494809152460585589546153668756152823569747403345865082588895917898980046478372450211898577501909481143584602857340685147700616961338258836977360954386088465382199772923945163376751970530878983313191450036334365093237629287472224209993342991805041130997498959185937570249375716108305324373300229553943492344295909298375658605428211613023419850749604283111735790624080321780091752135747164737054761847639669733052597444099062395116087532075505747628520365336152156358193756969112662055428434290021755122538995621707033527397140221891082688534740582417084492740964647382828333415577538633522494404171326857881833238697532931996968058953903585800222708320111597433972262443698405044888163252504085153166450300959060047423139436673022039668525300548330321571122823219009747486522958047461941441496537985810563530964783896378142972077636162171151472123736316933013269140239585510333727693749015301891588664135169324315647035924667921779766747422216308326892910359368877536570182230183792098948095797886541120800772653800197337364869505404093638809171125866925219555256579703610473246255073350823976772439901150853713361581875659625430211933644451612801863152419962766674790046046848872366868808792034313597169172868413462715842908245254357838245521576326945005056330935924732855357573831319410521452505310732502519358068278750042395337727116967491332206666003706059530454024012681037942789258598213041136614566004726719437056959835219275525284807352054972196499885900566071638378000082873791608053249964306355922790744201659275216901761749314598949142579489070919311905786781924362258060580576505969424784692103014764722822907868630696223066651018043236728151297119874975217299846586370296336823740379864088908307893662836611239199071976764757387055472540282529168191677591226102174810418665761063516456556401514708014533081695753211629290228305869702600098285795732877542243067193597122377605656977837921416168204904696798788205501537797664073059131142470804936931546137896285646504957165064977186848151259065382863698397499586995792289773081069822172912993808929962005848079008653435081306014159472022120678535043985638425914458847520423308247305736866571101439471705588562763128616799272763004402483578836465702571080978912427202110243099465651678870526922662609519501938048567381150623445622027237450018213187938719629957145386475932621601949235487992333589714105378733125521942254467807414516106009101556084811639487235161362390442486844858484019137903177801731547319606435174400031916777713967155521355315638209906215686590998557996958399656697117776329309797072879876807561609304848130024555199807920027897410688907301811056063429693375953026448936459330425652937539187147414108888939870645621474413417894840319463788591556263806190221984124080151568655304973839046875012632290953699295088148612114369775425776049096836239321960423875531124250409388405749420262456430197007767825673438519714327528175923341274761429803847434037905655011909519327801712552734003903100862344652768716680749633004262172375386229881119499340750155337269602760388577263520601139129380715992708687636732304538775576185708563498221437356677639366422722487392082209802006640670135145004990149763780155947218264855426765782741452871456501028023152879060052556603450366551155039343864997446325149881953836328051653299137618497132657626261759500161968684268212393493007422672430604970938332186949245158406357500085468879952954342188219863665479385653294442672472741633097751217438155357006195841696369288850873905238961406985302225646264309091448561351538603144735946848611716641019527978609204301637822303053127167387312304587671092602742145203859281818717169153970568506717666579516792182872061557676712742622155188816258120404594030258167385287888992364295293307744700439252988725295925651365394854427508425490503591066580687048539370312918946989206015991561594536082166046608716570433173586863961323668248744086101838178228667418091223281792762634911753003315291810372702170482272640721007442493779127079198998326954390949564887238431402016928907812818958964574380267329498028051170744945979712322380484218171285370463795473755840882454078535899672577055784584888023496587041275519327709825488873907939811101310996550450704112611114635365208021814530785914952070483965355627201808729042580653208216215951883965271653358326315837146466611955443091306569939677433048183358197622678612061237096553415483174309001268038399719187584768349656638717116543627624133516607015369361220871927007833954683399272186569394878998098984366933292592544682940041184838114341260833629643972647706347733492889122862183173608327712337863858169204414115450612931715376035900156388363939550624094292300264937424509054140145593059638501050092821960625299171513149408993108970184346781178345901156991848068558197933195315935200928631397003675054557267958793031525708633077693058794803088873588740848130457061990234216859010025373517708952497219305844671273202327023558867516898900536903866811612300601978973334050533145627549485344656669493560623543774985337193611455876390405659324103423408833824509239185470144501249198270129036476350160720231998655225188290820046988352855329140845993011733103871506870460311769009284368803956618712037483784625553775107248321694899503979183339005983146612980066836901682175908903974188389620877478930567863871935038885883259254657434278761281747883488357146535951494781363623134658887194012305415960763185119791200001118805906253478071652564422195195417668786805028806243668588427056835043829729856770146634696863222672941978678413959986277543560595346737836667815060656010012310166691803569269858571598203604166953017648233237774906279368928218388394473678250713652031338297801611750531169389486448433835466148462143099962371201517362883436916289476027462085698832019511268996660454501389160636362299373195106631454678451785363143817584715489397209527046292699055444575088520413080758146245101218711168237603760685789096101022203427611107116662321232919147616847431784459308222471592233251411865222627481919287620274357532540741576572455964033973035454106472942566793972843262898399375720344600818893597434433350189270133727271469737406539280553690988643012003860549631239457793277374964517305171258682137528281012212219564327696493397810900958324641874821633405598688455661084208833178541031468366814582711793221563685114813562799640531587715999539631604796365210289423378127267406603708908740634664368054235065386422640837216388798352463545327636289241415612302387253328388217127132118620166632264326519762066210067269287332780523376862386550370603150406855833286976426047816412662890574654678549961049119716564547137276908932905146098730351524471350507190918446776237969653014744554166110872533085765262672494196732051554414024469762733196639485130384092206310473121123963290057693716057252674427661252853256284291901798907999567590105119867409036740360365469130390812427158785471703989415399343726870220325404685987796946439106617875512305893775993303150531938516119651234867124961456697650935819992460381315909094514606255988375205718237507868570212891875240913308045407419984553725074589104336687709818176281427001358627279402974000960405338856451659033587492004304894640195035420089876340721409562345263380334503816701415065300455283699279204610342673781776965796820697284695834933058336810060035264499053390029141493074980388267348895659586171757512647253264119646148885326867822678682659371147792029928759834023618080771191217388739788636515973322577926223731567357884947144653238623333863049589012196050297708316093134252384783103854633477851079785322279920595839634093238763349425445150269511362409862003459223910306945583861576478157190321747394984288999961392863367962789465013002466182365351698745560581304813384983206176932552091781291419707896707197964845755259859160151547460375437611785396531311538764006554929867701308339485833629639558013251596435944612753631146383795309868970981874023281336252287632124616245692323056788028703885725143002517226760522320492426528095244102188411803005610783954798029093933671181861950992025755543076287896139423181626886074513365726817599629530651863534561594630873929146751627126872832734007196983648686639429143528368360819383521172076280377596471989275421075265984927402505784322964942779871620360271345915707557827114981021397553253372624588541415216088047506180539084837412263416582024726022886901577063695437539975561035080850703292889959795774009700330791368114034484241200003519505515175955777492741940183629228642427084298649487426290343632607540609175523330320135346215692352827991509580069328665999731811049966692346556947542526056083121872764899763930888327369961971241672827917605555545041282481504352300763244959792784676792173883725508368798418458789661311925236254191743096847041507833934585433851855990441367354703810430542051539428602669906038943892729298387078814201436920387345302992152467121678082925345769660907839178753280933730511910483224121565451128981702282321197699760048921432686115925413012119605610449473010304081647122434571676653907718286630998973439637674780751736780236989789409104917308924555410293624078952983607309412395579476504442297038020001474635641131777331843452455628223516803040555994971254076596195723672163613883546273572835024526372475020820018822555852512399385952635416009805498057768942805101455995588881587545292230617706934964006584787912920669433281523462366733840337069862505722909100514190786808967679389425620343976644947510343882679190605715771916369294497781086418687524820952953021831981832300708573135423160472992715614355288705335341547778931114092694763628349686513014565735291882302160960679789825422042491068677212495618958458493559052323059782134797197369193419534978652769998483194467186897499021158615440550177912806853703634060831594680066316562651212768967684435132867439552618312198312270876817975765710226390180942093687548836331689325194042271138131710245341495481344697011514225127593513597783056026481687505303474541506971686931228906841593026771497157665395745451198334839612693522570899796263940402433513116567624595380654220126827034433947707107530448016159364802130908253094436329954769418861748549061797758182077979052455779401327294019956723853135437451947865672393042919616069500965958233866296049051525297993930599507930990468567356620260930547750466290362377795100017993733874735364372175439664480010943376218751254198190349898665234415229472159479396401703457870921797767837370273047692354169974568470394912428484736819152432071960592594449583103583095155415116953724555878196552329058449336450192068811376619382698881207506271752246632099186088199621348698307905517937774240291327387271831897227902987815533077167452743854690338254212571237594241923980036643036999032323326585699173312183473801976296000094469048545656678495132780278685833042716297413017020459847838570550757903032572671714468322160005436545473741881279643267032722946584184217642144434039943052724526500170002488788066703753725548208128499820983664449009152400941638294377290081861529377732414719935692812959879115419944197038656328480402876707973394197916855009882431636982805506566385212557580689580540698172485687608966093899970145428312999113126297098664647617560738787759373481590015907534282883494839531488136939816952090777815592514419079725686415612893747951581275850607719254418120006263091793950219428162968204721346963641451587664371664599088351106059851422138505617082075273684108304180725719872760634927675660121738620642721341892584056418556735941873750348198267536740959336387926028046236519588505189790624107620739595479570633943300646863757710694902788349440130802071017166844758099030637012652954225360208786817216289423221243146864746319656012955432612526494230748780123840072768656191058287008381534662005490313596088675383316032420996589373823172344376928228333067718965856793538022279702815331991521897910303866600257423630565732858357496863116442019793844348229019120092403591636079348704198862771532110934308102143901917727864254407360588374072850575709136855155626531845978739411313703424594355573907710157167887891982043015670625664608052069133771609123862904150789852994486230001973818686172338487835041208488413559454548126808007859512145986010777457898598371188397351959178930893199957205203739986155089090447775563611069035564375160833528330863854733256896453792273357534444515448159361657408423245739356374924050649240379152335442162727920804219590308546551283920128399107121499043788793803306606992600468294221380300022475700231942118792639973319856751615278873594953999136524006280296257173915060472465292469383538250694685750452804631592143112945963540552874344730443746872758791422300538546169702836396720069900116433552372391675894368909229495870202098363668450015816703524480016286943818100100391594879476294907277590403046291353028282371692033465148520987326447793903829218521456903954230524028764818205611749211129684611506588204231952453809435937207063287888955181286127545372612635721387421679567681249008057537637326984118114412625524463658896981224545915273072632310023044712841217591595274814001644315960564157243642755732676694857319964623928702894310807625285613799204695846277896995170493904300380355734871638791496837630110192062942315834561857820543590559546442579798360298661251359136926077928783142820833792516852223768627363982339146560972138613782800654076240789929640868970480358817800482585687478622155021236673408876766514897588418465775151272417512543666121343164429601456512853111410904683175073056643499596348795554221969204504910063019822445367574672786997851622283198351080100514913477539852527086974032446334844618797860900725767916190698957395011295770007657749138259354669867498442910501886317791468690176198686588111365509498431475155594564849893084802842984689178201156581267571749011155441181509512100196094062257283513957099935058051142157790716290039499554597825215498381232229294243992586232924135385613344799567800862249078944436185807148729945378582468885347930148273323688701744378487534695761332661112045050186389098979914896566545289143594009742524430102996619115919672071125919321680382365711691681087705822939836327335745207008015525931928228438515462864236838760296735440116332196114007886930289607612849358269097565793727811313600051627435586350884644000642192609237604057493813057868265374885907286501900159262080612342476961455448790779513964863428977721748597204668438038574719283144168307084350963499762128830148791794485625466996778659381854346837041343339994850967227070930332306011195300170307648071825626417264129470622922343589777311209940745055483432186047194252550311462971059963777609241221055714176165504801368513025169812491387290470071682985781816575640062806459657010564829044240144796827115483304326922789015429423186032811118650342246088005840318120913651628218052406274103946304352442942108128529113786335633383974079035399867526146188907514916569706192831754743574719123583273291602652059544907927878740327101205028767727618086020017656212856679042796464663546402647065274348009365668722214626699433689046005132699317256018201308902370869548464588833207487499453709561856741090163655053151826799868249216563540561852204138830798038180802407417356719977530827457089049201108945557074604173492216824217753942478917260166906373683262630559282066729443874697396601321223981769504927629983335481915638637672644691782977480131688000247578739616517207201950033887588217155886879957474410592785178041579982670221138998972381656689275078698525392833982097133672328697172963981159363915297964269402007553975501968437607736772621048559082567458450700110451069655912312685253153526271687953610653273911664375677196138984622548079597161557738317166085130908060168032156931706632213547801284311798525311880934666940904773844972232620187148311822699941418520601252214657436371675788631019072784185900059707347995476828377701376049316077165767519781662029402480946875929298466768040462775020539088521748466378391292860707365625112491823423953710710602788450025115981288534759070541587991859240842009692676067741783332077189319134514097651413732054384870993907539074457277221462282162803062567696039798370374953626152592908708078529412368188918849992226799494176884216967520813291298767608897028344827268699005076670544623499592173600897862300413976732261650773850842289802335454615567183758255267370907012598184483386047039964936883895957465852661081131352096276623721602521749275192416708068975079664343721950118053955630497570784977213502519681030607277398848243452254038713084305450482739888341798738396411296088915839335578985643348677079685588779309655776718638908807506382995020813358985537489686075662668174200737675987981563918428786470180047808709565370195606229032514061833976870692203798251477211996117767682640433780076592586825738385307991488851616440742845529671079372685875057769326985556565552608991617289075758648607780994079010008184585506335385541830798182456789310230746924633105737196594940941672759061570620292530802074037166538292964499575728107326790577027542947367675427993798385484939531304763705141451558016795469881702812789030959051995403540445020560143831775726367132559635238386687439806043901836533397656202638740579069835345981991055979058402480274729254796583471291952853313563548083323240860692944875268982053889408509100405845185748819368771647453907738906950238268255523122708114765899176915398757022042648961463782742754782824044410328916749868020385979829834030947218196605140317736133651926329629093616875680127533613852474012124486974221727907550569214343647471639534765523425115167669040949625195985589460195239979913003793882011180147068850954803838436951256540896205311631608345624824455959720226464239968248206655173195995319280273184049112351349890382448871721999466100798643147452843851945515744315585202721917355313061755748545417275065131438611937893464153054056910927432492209090183444227815540289964437461094912793947883927349496854700472212502064208597210057634756793064530697455170336157436055920404174273537346606731281518902115954916504990993838177181751626550931961558279515678902080114150635818155101824572641314930825254171071990379312910182163983649921983908232059393026334435065844746504150100048856790442638806785919673230582528181598211887197083814225482867269663592300715330490013357618669988136974908450102111811735229630425049601148245680183225484019656166512134754196515766145388369877921109217776800926058074569546885722699229115800538336606080452340501362736534296449461293608859849146966092313252631751521609404831033126526336340496122648001352047818800429232412776352281556118141111164101506266650809113874265230365590167082794240332818869656288425958776819201666617127195670092064250420133534107432280670722501487455708508371162225551193514176649676852793825008767275887523414439032991353479328849702024591657691714665383472268288830200354303344328757447636652935982671020106798476579086723959601883892851222181539460853262936425771744465207184492393218475639496069693313187446982594145248967501676058032696432573405660980900313827199455915663438867836977388833667900196357543133578424737208512353300118573287563111742453639257599835007961322062593857370151988166839823290564242393132426214769156455219932821323766351792711230816823035763310895079490400041935502054692848296802033660360130694278816623395447338623240253065795442292089194706875642886706374281481135014134978278063985762597331051947831541601909726300606091248277522265468383032590854774688106656559116824221656190539145686525404340560464827794098021138557046133252226873651664106714054152494462635622703548294804293483633998112382271099454258061458343693765049305052330884307988583983647572397679277517495825399796428444913171518199369577041175926400164527300767282418025500670498469910775793759025665140560488196485214837861110946049361662066235696148416661826534380540311128175913870839439311177669015711238158050187999066736266662873390316408927076561627365213996384305257399694302563347194104792992382190328852819304105614095711185163835158645962745632404365581809793257016911590658569191214758873870780415024388804281440055331653773998098522535604553340542265165122643790837098564535998438089739361059027574131152187023611981778878235568208917003963578371196684498367292376011562453269021807350721846987362990715815729760224623613146210281429786630195444880114040339131035884820057992207839257718060341084305056244357348437362041232621398175028575915630963628406807376256490624258662570941819721525041295315863335018767168725301498417507566996451533644728480652602779346268053991694706132531213406377995547205368567299876832848192195165132787512187607418887336340100947807684732672127583444522347638940736347903091999711599852411699482641994448868949178767869792987276588251416939164421066535996506769209081237266893104549133781800034672065403124415874601500382672989527295252653212516204604500081264626685163982850408878804013142088538179640125516925049160704219846826641278485223975522729640098357748830787626463662522649027626831777347284628976923537350064416506751460941485426059617571582438739535971553075115304361741716331254594325692297576038002923363917463567326503206009331655923555226489650233754566829418282717472587024691165724973227049582608081100775536652788921480452217843312481966800168712682553653452803163200144662326894871935602806589307098538139877976366366628078621968732646760035320432285629537091043445822159112973398863271099854918701574120243944175400663783628713912714998686257533195578624489388536732401065124152569119974238003644735961070637047494734553857389473467659692252513315061232614431969032996414797678281237919156597960053129864461508614287589666835949195644283443148793998965638062914867275921246120642792388931722621316536765804993819133693476344315605154846873475677990318793329697639385310574304771594392339556940314476293159070721203257244930269255163907770927629483980422985358680747883518102806995585004323623668815828210632965238367477510357404611688480393132103025789124765841601288125800258387629704117104726803745974067537163886808563403163318110938973700360268994315160902732655486583547006238201038335110282070970689047240802351056682342309507174608297859586263074278493368174922130778261574824697083589498357790414805797545302709255125607251943772897823036788545337134670067375293420136300316990496465455776815234124040638958169136810405737986860705280393547531542747767209160401072149597112573187512186268973064657815641228201242618494892992791216127829252934637067119078739342500650675469064944515586411853295581175867451917107719173850319676597521153416405177518237492729003692362989314923635963730786747834942325117966112892895858238025758956810365032688176820085414059229811826253834638082325799350066980414946106191704656937865032980372601944152045784539138839406965082540850096542957929447972851588434074939680559773265304178724484782035853592988819533952641664855189379802983583857460902144072114217702873110207425815276830043120080464300588919599557365293898043267250894787503726449205417769623724294391439301757871569446280247887006737121130205276634788214324000791502810912722614995849573035937618052005423964157025669489687193292699074270837742118866550400482884888443797573593179759669619071504108591388760367266272947008831427610924683611709186715030350701464027981364342982240947681940343198177602917188654702689089329965578873435713888170462928443224356308039848856063339400453905262734715493544340371998936283890277855702759407344235918386309757660972266775166046161530661990718935547073792654297931639675361689667198775873564213844482740252315650622914482330693919135883160208456363916619886733970823608132255146723523571259188558045765484693548468253959667217480021446544232964341934999702769091025184631353899327020903616991035171113312580329847547668412679389239954573361524848985704605575606128711962921025163893026463952838948892773047906595314669590516326575134122353077027254962496078431760993671043742981732713141318136114529612548305175321998959582278043255596613794348452722192453275188502587008872715045059324686750183343901345006228989356375268940474389135538869463443348043983175336262194707400491473291176242518559233230725746037159970348648263353165825771829522654384377310551135455053058266984275028329004868634156339065114687972214122876200597469309915361425902119895801921791103967016594175132838993133863348269395014757727168888425182445559398501960954682562677142418246666908155891450337265659989167594744614008552579125904348387015406063479802785693040458720213444076317230842511712982205291911879113451114338285440080222602046818926795058673461834107793168805479437065669081502120505496596611313039736826902935352397521275130918496180514848904086237177474865236319455417878922399289263630553711836515924997773483141150003348342589830953761269525334651989411643496115766511406251637002305417197404230572327899864013898836754976165335290425201519359414794118411075770359968127130178672086097180008569290036862407963420582766318204170130937137311675576247604688345334984826395054755536402478679242850252857448604951131718250380638001328663400263089599987487893243383525213371091261862341212229926448405773753479860448554216210827257999065533905167848357224685292823858867598076515748810617779605840711493489061971654863545579889518782476068783038122225702193944726183945210638557967640511338052532640651455135686308715534351231711960948864989650540252554908093206047767807904700163453130165274883677245288430794646727907543195914249657582049830715338641356660101378221594922597159832294813800722036419447505169022538184560252460664677249428489756476106107557180375931169157140938039373978311975665164650238369650424036922791891965616116468342790838326685891238811753927958138658248590901475950979313333305971322180707081851511319024581899263700900009767691743376849036487289257364019662300352326484967822056677568488863169109065300596931641010783126512956201137860992575334613808702541172951039519568679390986560542015680772008233382666555695283660076280071461580473516064100702529103004476854228368774397738189472700528233362731030411117242626235264206103329905441918764872499383147506781224301194559946693695553821018291035304037289567856378191883877755287966156311625540231679350791685507142978495419729676717901564767009185537944137452404844843544848376539038309380016400853742157400008301193336784190615021469633889125983818579665579424632327488929765022508807430686872361918116977016450149949159929058862917378989111379212172251938015184650400985142587240813251467379740386994120744030374078235712403388583959751404793275523339189882099609027760485578233704206405267666553151556048590034630027789811801084961037879435310986744989773756845416534419848579509462012397453719902482898667988335772299702079154586481531272517512804569506363763332622419103246128730754922682057866605917659975134782624743084670513587140299392043024270113699386684983963469867356929354351849251260320718867737412394535663844075954710433365643108084489795016876976261745878971820544444199334700686108741715457711155473888874571375027508600217265527218770309174385343431349900644111609059100343438781550616257187287376853296409984555101212947129463586357126838893763108786947597842522149090965614583177747283168877278427680164223503072715969249792389105162899395451933662101640850986923499511919010975410954868798368582667549253147851348169995419070058957779117261251952710049627119945939129386558697753320222151857570352784278170710175849391820615488270138975967315621265107281358413187409968459151947079860981001303194580050432659309258215060937667719332241290966805168884256778123615204582002036554099923409294760131989351089905779908483547026007023478422926986403196348342266145693171682064910419743732522969574012513447495284103639599588320743063906226251254420802716660605314744015095205937468983941389319012378492339112788100142055605529269946481918444102350827475430629965829602035625579129320463467356624629140196738195327987639032541195038417567961511471875127663721858326847468126316185706452290545350660127679279843630948746839501150316481977957041362679199202384686780827148391067415543828106485548402136372425486453405617916027979102217386103713707005135669798706309583636126314264320290427031808383983834144163982212635887619791476052636406456166766974528093532184367900190123747016394828155487177277901605793947139702120258081465794823465918152043812275908001201583727784403394182263435614315665365870246432820762277134036953988127644941492054911207533907993417971712284253827276419579175151036385100209675590447883245251277138501915775681263153838738226789524409560422560909667849333228783598900185223988999125320143980805985480990882109626293765495505884266238072350836947336993847802642951297473264202016678686535309790534755330616461840466135531395827843485333121346588988532156215680648660934512325453471160643765513995831187585294420210724558237267352924477144111163700977884323118398534963513682890176851395635550600564432464866502796151557694806335359796937617024099881774390015028470404877386102755210735314431547644277332964972430256780997890012309727391193761510866746185679003127302950915638430959110320153857946475137493538231774407689057786168758525170228411199951158653945623490260869405034008879696523440821353052473877636373729033578004933132041509285171247521447147197774328078753574668111652818114683737787801973915597785428840316169769030709018582557923410063270768255668042815137133825023394920394595088488486459023202744676069881638949848019738978819547339219764866350967242265422253686406264822327737400551066923352156460876761564975675238973715101122155693088098139478624005825184672700284844006047327289583485229299085959636142246699083735572936349836165192691619325589778766373817795713598494526541793373481987198762781477185634776454887800871525185141745517605875099364886805409005673598335475381063946219627494353946340832303868518627835535977179906058233886947562485776564277062533554547530912671779173956033933265383966849252337012238738476745599164175141161194569102857574720407900031870841337341007469777616268491007220592220562199497359235033921954886656119673160636216905084866461457564174430564070943233917474191342935560479582458695520463514452606710660483029109602575626175654940163401100491253137003846179356714531015705936686959720008911596398161533991236068906942354212161122784688662425108567985832488413499018472178461712729901808824582499474149736813790387710951681715390747030960536371356840541820267070988360092511112023121449101844282269106747981614269705789602319465707029898079824928551681240231408104176961337818177774337430898981593401752478486139411402668032695467233938913379174620118307473210598748414429343067382212860172857692564128536952453897085584069069804531342363630592133281915873162602133794805210495454681218082711794934349987876510179430043013487940721167889484259436115916228690474026471227979676826863295402311695417302315276888802068191027078805172127195848364036861467820206144469634175961293633378636194187090762654480311813435689089778583791268243501968479066839995281765822956359950302388435178348368697722477457420436246341300820537870311921816924263001754142347748022581498331208207992867679648447415639954846736573155893947601357846696581985309650389863987746490258217587640673357347234345990413988307263011922980844892405555366218708232984472350470158497049040225660148290624966859315343920240393516590244827424721329522732098724024451461090036210511799074526293781688539035283487867321446661264608199845625958510965393451696808044432823733971096032049021858046717578450519378595783006984117027205355381500923632679549603917996995908921901367900503610795072993128777982101531701917391173729220420884809009139884206645136018364525707067482049345921706559168910893651859994146963490635361697598956071631975390455279482940413171462566634834758159192674100409306573868352452862810057446236890548208776214747485577150100306138153453532544969896078008556252111842584328292937778485999173928072531391779638425822067270729500784558032272827500608123775252207037245881441918346052427474547818808653019689769972124557745730295394009215526120851303636858507097613938316984526134466444155963157182702902487909345700159862284303632821401010658735437229526570802935414351920880286688538357475334415012153865976350489479130673246337373182654924090473143503079315939334164687687666852342450455030831480532679409421937214186582738356120971096299265760752706050324303444985509751955506787681797691350708647795095083646518494904720837143164223730259555447926632964323479354913007517317244032688243501935428182998438117313337558582014748901050925815199795079311089120696166137935155508789293801776516607200473235141471959455718675158988173603016659712586886743376058894271334190772439548373454867229796009736163276484256809805948072436048719568229774138152400749225531095830655922416919714870584610893036829628486569462465242591179316079305547702035244153813334792237847643400673902528541358677648561454810800861626513462798973190377606720837762266282414846559678222560785095837593266813840153908558332931741148122082587950310541000244263694975984694699403818009281005226145945628171891004947309068423022705710380697960492533862558187806065372884307484548998767685340987370322664068196954185022547477233609465772140220413080874425470588859353891754909712822167495800615670413055147529299842876996272408032919886948772682130465622646550574253578565570138515650356866008634855047004967790826217103502262653764840228435265595984291330827881708070041599255493038759569478683140935569637377363929704657446158662119739398716529368785056902621809122650525525916650252220839916645875092468666412306642787760648708699913097440234198266345955849454589458382079751011123401851605947407525361447695894616498895938708893294135065542373052059817409556949304791006945775874682147311628427297719862385544652063524290974916323910025142185474451351635071620735853019362049055976914198141088277821629301378485975837640742919525027454413866491937397386656440111742975169385833465925124566467466005691833645819791656992884989243260707932595081727348213063868260124165198732809050997894818561050234284689541919204487696613796870717082568873734715206674706298997314438923623292321506996108481932475754429060971657024490383197131267727267528091665567950321696869747499691371769696399377914693005975798449788616678698167483403859712779070655689435312031698456131010945431011578082021458615330368915578532448392669168359850933821716077199559458028889148938066085251025007539948711463563532430356374610405191076453299204293148408468524035849747315067670328786408672542770464305647744848137759606867618511203117282023053181522842544177668545141752262446368996770861350523260965603355923005762302132519657112702643651913616046534261255940407974836964486185141659853878351489465241007403666556979911169428265571575957508462646052940729011605277885776578185858892963194118125702487700263703081641407452860732499515188240940137449291352812064603328719512782017673626989653529991655367890067195719093581783527286770515546296007760001992806005720384093400084395088476342858620161669020518837587554849532862001389516010905506997651948748079535447685710787559965582914597141034957126230739868470747306009480533995306592420831303401020875875048472841217154556263058254198083492013465462981752907870487899618860078213988740396933194327196795104413041581020425491451342187707246910218176738771513382024182577711569837363215839039449346409043596079118790167085887056330197253619250044783038037004615724440874931854205234101512778184880493912549080751133888415291219896917939069560706344093634885127910443446509828894094184679971477900890187611330870587867572599501732811715391592500125216293312467121979785141627968563913860490126740796636348566917060632019130159637886552389996076100423580377030897029177557831660351941681819583055488046510523209332883506640682311248801364775270027666639348806841440757740530302940946003187310970830718121816214489370266348037353095976176700776103197310384247402569715883554215100205616663674485882986540532649259652610805199088523263896861914258486972965227253955521614508672613638631007301162990499641910619613653618659117976987875992986384073018718003740619133392574046031930333157609287558706902597093333080389585505406309643415445493679693900039827829459507271806559805201005250065428970397808173079247909087893452037025244749345150557012429232918194770338713670130518604646857448129885669727966873847609106066348774375858510822527355315380637484867178221488214908905440960533962679434426717505156718293095399233087616501432226414067114650349837967205157813975595203076811840108624843917731560417841134511764290872904121028096763792818200267599681558657934055488035706531113881586344482019835761841201414802804863322512706986455085357325397047984540437615258028310392245645915325412245066094637255818684995845900483487083526648925747516421065906223689548227730252131592540859247405561068891823161725755274427342518227256332590144667707998138763564896245104817893475545263064031385283018174864288057722233282354449980482157118238706711908033602675990852844790101562199288536575873744171574130757542523590765029821262189847552845966798711624586024742111300890111512479081270445804962294230284794825963122205753204958264688815202100873217125770425374434411504468051042092160874282404085347051721217263150638482755885061044371667068027716174516932943269720012425066786811498182489370616837572792569720968799120945384540260187295407846132260580097138581197466369882695925693119028987477975484032492384588845761342094186544401550931500065173945205396861940977322548597559746977434651238385821738182641236537006259421700279405376571434475561151366940920286196537769392234143846390916976717741690811038098229579767530044157420480794924143895174642621999830258121791442974479389893490627623606710660439151684835675039956046493842766798406410822040686618917919573248055235374957864575765671449776367141783315623288035732925406186842410559140758709678755361924490810870287471006863621131302220442077534500401376210569746027200277181325085631509026782677901242566899228818488343585948257245620133401774324063528276701707223896677498736020749437246495246900816455654563624165803981631815330535278832386662232752492499805974942998395986805025705886882801093022894016032240219212581038792842211866601375342431083219135368426022524338349825892502751617217400198276349675956125327267379383813935886627588534373072038784497448663313268452724529823168582018997024759777749801054628754786497037905139725780192907483623169853132624668234614235658918749477025609829347478028279191756758916092189210797879674791636897310971196631102951800254165769819833679216086298898252363232686749597960789392639310067284766425410634887895498768379267786539755116111261186773229141772914336546484440213456881584600091120781269950892441442739523829460942667282751351128646292038212473673980099347874404594809152493521117282919484765916159759050254742813714566184992709258811686126621184243512837728030940157023777136859475684726745235832916730195608445680942775451480881206945878185967245645975366994459365500495806943368851901441221487301826453761304830440801631040058743483387124927678155762078808668876846149185837915031494178318074037025949242491680643969567340399361060070626262362274499973826558517526159852895675890064709483254115602731297359327248630937520337465376887321284206938453837437483913846230901691028282455938038701037295982391547582840644699290373296071315243948359896337463928892882247962810175539261212353140863293898872702289559244714779518057443232823127004367521370025199977990666471602198942834257336082046377450473440398872938894101223023015403512867554263946348011040745722788374573688552581166666395896098156315321093034348214775251306206843658442546385669317655611839259230573479995841607943574926734024141784334394064845118806660295461083997871623361134704216741632812512477707220687900181600855602308561101025649678166442263928091197938084971608167829992997860517841437486091917578118092989710991829477387886747115119093680531227103138699739101777984592743727879980661438010034594734084713531357974729325976686951605503796306262114713220205284043304039097463667463213582286128609128877734594033987952379706550912562137304909927675866916103998647456169375455976380319697672098577546303502232558053723781720876872857461012023393779690621635535712476740832959058214453888637152851851423539231812240785388374900707089110567016007109471956642500911653008133479421325592038560703807589452728743345423596958390524089769734521233366387591844076398352181671948747032117948229602746812027438331116550161611398396958286338145409630899699647856642083999597211799282344478821156839132787881467897357538126478262651834120171573326344801329928568824399555419310908815756445049902467824105151412506335757978275659773497605882572135766926953427652497863703939566960897465893437778551171346352676616756437637704394779283015710288498510067044958348068760957930829812171949313782842923511959476587698746984456691204612930354062817005277222348238067696538786640596170549827567444854900606263789668894367754001951891764871812384662973139242781230198789377573404291419045277020578952767251087762292293892846899785784444392793798762615068331204574649314750679097811433324511047112390626603190455364583133167316446775091338750003855816040309131014568727413228284001608311995409498539423361890936431320767536679925450380374190467356407937781535545330333866228411689893856214689254713313562191605897138794352942519635490880234184941057655611523903710476824899277549754875888791507687954593563960099990225183364178667778447685704067034065819416757751344346969620382189276715768939687285676605188447557707673699798140940595364337252928378830588506674111793567680699617205283995136522255441545624405634421016543697783022745829940577626307574674649952486676334595164594436903989019165123791363486882624191795310361003964114998082328985199277850743091597029414858063815947400778410425049716920671787013524497006356892518808560394834378473875275129953881926808236775587585767746216403109802921100132668419285590761356623375324509553300096960189295937068222354653810579265529417722539504935229221821718230130837505823821354928552842172222065923123010005464654206285550575661996060301076953533504925367190075587817847267610739233997488747356685594312840922929282109914333805335523295789364651641134215386304314577709497634565502824606230671299621190891130880459052575424609346941807577876657575562010716683894502424653133749832374632214296273673273703635855302226608473125916378578404576702951390329478166888201583029515421464323301565757074125511438832356644450312350105555518167847810117063451824845131323988160532120998525990840096710162741031071196828952675474282154221237509304793571506867954694450346769101879527824537041541296933109229395245399809950377089902747184710505037473159734763783842981010582639009746808563614803683625904644790566380391918975729199942875603778919489786115323514465827500125577151769295275688981877252645441528755178937351629129916819104169405164005273046328942676096607218922810252845439262725636797968940369324414777343556227316349134504869909135508322335910371200215240766965119717039764030288380855661433803546057354243570509441223057229486446404920194234129576069143681233373502170201512420785934783756943762590482213666334747753645055245962135017551929465652489362160019964444376636633653924145688048989855695610404053165899062627114914542398661061784076029937842549048023443879524422294835438386468332140511813279648637962328391913111842567726225743144113626920538865899614900163869802012139229952597242592829075555744495754628258584506867189484440455782367614634343970033846094327746059831347971782678538324805310332419494152471404650006842334923414683426553115862587005693037184737431426240936171892100970970643095825889946981572439308506393264646369393919917433079704987654674846369272273576590192812961152425391113959761730577869421185072000083557280588091376419446235304304547668270396373803125396859906352828950581211321766082012501872323386129259108283126259561968950816019913515444159527356874058963522060488854210147108169566855779891786016929780527107649950244651165916254540388381536677521493746458697949696133771286992286120173959121431962001393849198530322388139288376413135521418457381012322306280522353366567138779696867031562339301694077016826677251384380221346609775423166374333094725244780168149007114325755636924332602286918313694012489958317956652805216348064463975440067708577055595598924528407470707430752876502512655256126174676101324055461270967275224396214595209678400401355548015356619245469984338015584662661043164213485667147982548529198454076074283961002157754734675004438681178020981687383746664994130555703604326627254293118876347313854839686775134581842592225266436747769520868379977692818705922069687152774744419183478484426725360717472306114751877252121219258280106462422773268599647656939032131899739573428352441330144904716447310419609847496779731973748610627148523790922056136748879867144330606976739416948900256186864034439329733652077127103549381493526490582603559137948772072085577230996547909995255288544429513632326208504574499704285695102197182443981138259255911917021569364340258057679114630111571242170031689207622658880550347662836988804374105919117361729831281595097873528671096880124565604095766769487684085181375904030731393410428123902983916402076628804791134609946227325800298223175170492558343327823108838696037671386223312636957752730092065713965283450091175034823691763873041127064952158702980421950156572737371704216440830185988350391316965772229170475132950242101527216877552688933113214905170389835707373496067486093232475988187405843632138852861146772801983773114170454970991911797839788786356746066720431563393024660739903961511812465903582452624876363122316650308499762195081812035360987054647027940433545658216973724785432351615356458573785737415902770221181410842989411979003973470200019819456321756838576685703564756073341468007760704212907928591990740848740263248736993451591138943207400279876029336549160391159745832908861469595633192667371300756857717816698146707226354595975577813384201709230761836758611588661458976995528983638983929017436770085799975055297299977976639570095477994918403059585276753298314134714335650031224004223788700136958608143913336322710631356423533442715216431165444176311283247736526544905143315139092815331758049535583088141973721266102082757290858453779912556322616938588568157441975765099419830239818791727771091849889908442602001664949251591101412944425524383312833031175790403772760112262912841933801415517386789805206015196474926924893613013450139373736927474675129665557346794790729918471974894391288519686712674649568729930060480014898146191797727085399406814298601506294376145598039821278565923532912022229127647614335308255152760259603530828283085978085391797363154594819844740013270872873257980444310679885939202282674913584464443784231954169552265187947615715348986565391818651438249585758396798295976961640924444028393740968793626716880290651372096300672859245083601805538068231198610826029302205350736800340656884657830358929821315701794731817408889236056924173391724344877632845960099883982413927541547984803112952861850642255427290744706281012190480942647179531802787905918197633576079631498106075862432835575313156120978230563828806364587094097145602876903098681202852172866006200622949445333625397595877850540046351437730928967458331873968079968174973495785552248671461957330161340362991590211402888144218674155229388027465292590890712612767521125972505938499458807907436147181752338614221193604528784851045905817399681885092235210719548882540840556167713914035856851864835930313828028931505508545605914561433371839131864467925528267657239233129005947733529681968153846667603838389175124697409997802140718879665604480869723985014005568234917123877880709997496721214317569669080478030212573245229484958810208407375748359986052326775313062331186956013925735709936020322709900472242713922781738266124822287842066505951320414456616273676521020540075767481075620234376900942448406169142950980205045169751499668799837793299225493250631772180908126339873871897087202161596540601591399130680288436781173178019763305915290139496148135060463593452562222695266138034050133631179333617624361111205445277318644340271560679012618251309376607095727140052197351215353358111851433885052863409077744284786460870756883218786560304430932966423615392508240893342182088271538032569974540160307517824091280819326920607262458682380760063000659823597939731254527802316534128525854476824929721975813636566441516767324435075167836766617647393889651941571856495844622412912557243615175384258022987602890622214275412773910258335717250871923425195977879805957105144519398395802240953850761979135150929540583429089200672407334007002060141498432722686190543343396765325061332678632915885481340173474325021922063677965937563015462564133362233692851174099123621114142365271330069427111604007711949263150675799523955210540761337871569245370188244696907743377618124211621028116901297603403568091858914334970460222797277254231433421704837476972093796033891541998933023974779313055939026068625816784502115639687896213164098103632692811617567986924943928301928083948548894009690975325150545379479955636896266563561399135592488178185606292154976348068650485006539740053950100130353006892983682311647597474207040432373997235480317509723268797006552672347389347397484119792874961170062025580692044360913681261171240653509934151114117563111402783161245836175212069228383558660170582837373409337937055568098856161304113303376608880518626762347731670844767508465200799464397884210677457937584790196755238740413688426447943341930835146852618316250011147891710124700765699302726342425956573955392868578555311986201690656159926516952586680035439796282232095601398335042129857579700312276765567559573078660556175685893933835644803869030027720696625480398951909183505483778001117169404820878108044222270984000659981825886449763222004380227232560437796609329423370448539139058495045175002095660137167598751720414659239665776839805988654464246325992431368108165239040061587970711483070598506562465420473032147526844218506516225354502465100254485298888305500240444959656966317234942391124444513669446994693555926921457651246212175753413882343748341823213244485162812231244053832000658178611961027991963795012581471230202575350095314907034403609479465772822900276913864695000049871538479335486182393897042050313845498363427502777822844928560066627279280597689035157390209086669309924436087396333924196567597939315334433924369476708547795533316432244288498797961834751699723946458743109371906156439191692364055355058592924628187966285051885776776811939375279412766911932754357137207036412585138829094754031453512044108859505794999696579993912893119911208280084590319176913938458330062759381362877751478203564406195010747443127021800427735546093810582376921483803234203028644804553535086891530132057290813473957436809905233831989744866648336546175483173906857374000298685403915398564501533363474984203752573187618901917956090715134145098853454494342648460545826170909937214298406584079248499907383829852038970818860751253578489786240073956859462151106400124275293059554365723456096516449175073886292398184734912296340602291115104591968352221886182507233442679765869223174046472671358090330730826135966688518582089946072049447472153818340624948705535269067178652649757515900539747458879894605406483742714809229023474081666519361112351284232267097710981391269194388713879660945334318818221411842566450431854657240657592986216022668582630347571793411499670050792303555123176139689265992853462552976315157012733828353519387843008300482713072657518281597450451969053384353204153742723671736853702657469783446400783855299951971646344462409736515978028902034257247846232019778233698156124290152333805537453657976575947618775406503093100029516315868049193970272284626890962891869588039742219357008156209510102719576238040859887020014489573069935415142060321296065075699935077567313569250489357990004839512334956726419566242878409733653556791868176182508726390845015186000348966615657565376625450431244882626026613947332494363637543685455224388163531516981845823041556328255578090414878396898972828515939503885195031581904051012505166250628830534378633376877439769559102279676565583952362255313405406031097808995397535578670981215437492726496268440767041590667317295708530701570429904802853225244516100181309599197038647663166164121282615412918454189696107998789593855129276697107135290574547069103290915226247187999870578874174340131079494186940453685841969047138706090732987899739929268363784577252405879270429217813221962575385081514334293479484591622172190459389425942264363809411068369330543749694085269047059067565146373340757714507344934416992236608147619696076290455243053091324433754572219385102657518129170558387686584013087580909613310120386135626438903217350059519134614356889076208434584051579358941710851374036179598270076898979423529872735061040019653646663571298156481664262877122174662704372326196311005266487664046077374457429327171715756159722463942517926938701816156835391549919579043533053386932266654228919794098400445701715309583791885108257942875681393310528061285970816186248328436723249648516403195029162856030668659373941263626470660411549033306322947353122023411630717928494332016300107161749446553524460904769197188267371522188811952589340093962140843976222803261190848456579769928457126220142119956080921871214751598622729070230096008602767313362497764655609809017732120415185402626290004458374449959224520771666922057121911228367929794671325257212235892338047865170231079607547908724242714992256365930639646042711146722499096993198972372610988199110608665356399614523228390719536977517702544984203580562397296250720317284846028245205843204898500729321949544031885443034470916762329228861642785368818226282047347353651650959932208055118493935163807189118426430783242261186368768039609856188096486731996775335008395832920651557521339484258152797587936346012667023912656745930040147973842300392491649365612374932404172474625278104505571445602193865124484392368588083895897768413722716743821572978518228111377235917015383608375452019706314835907893319271711082737411530920230194673708041995553611234950981692898430929260360156386157651045008195023496983500190504407521324683248967648472436360853222609112447712029401938494327337945164141804965331059136585271318224180938199813864132178932848221718299293812297018834122736895301520767747339656835042149440453392864108934670552781395258764533847611082696412209510119039609697592568750643616298491584788129903328613897587582058906140226636287103671277061597077362123055836587519134362828196679935764016038276763734779809704242549673539527839783998790965196773714305394861558897560742976234449397766119747622004178512724415641947297832565357313619344949129595917194824173643938193234215103614901322099925906957042009158064499517044016078152759476146765708231366591791143296772419675643171312868519696380679138186468187039558207634839427453941415355095434627900914520203556534742415499758749339131621465795945411726963045669409750002545945798082714309682480528780427402699933953940275416822058720795758602323474223180366360330140959690706327625550950061876183445620305130519984210844144827831280195606244974670250469159276122269066483818418752718952972415729915827173697231278576670765715511101082043797628421013148739114806543177566888287556608722756903245410640589987199558292773733511249576387068684271248272777574098356253363893049457815053347207305057445773470333947436952740967081496134196437630968777061190090052463289872804658707703563652554054590230226998865289671829213589158902606269495059247117927467529085572125459678666794596590457850040356371073058230642969145915978477327605326324583415671786724269831994232115973230485644202942181981696409280544612982819013145319808674080519037711104941479780895653906108513911729575434495187353635487265673879664362024623780749911612200438848183858739743384315875388599213127193475332975623637883621366846094038494119315396831546042287610959705269294602868934254511729462265223281392310650219812542804263194428149261067974138669532462376416506650133892807167722498956417862091794746595344351813063371870815873000592196150520908450981119839218326169943674007108063645900837991328844099327763815496006758150371966795493590903937473261039105427182885407243066049315453156288163207841122168260339174385945892799435249782211849615579875951118565162499016633159659503240770562440347412286935223751450902412734869050441641977713301862162514419828950827662962800458544336501370119756556579839910292515264019586081482729086065493550923230510596437966092718959861010648296315524756308632296360726759729546336720872746074057667947875367094006130425857650548007266997856272393607669497271771697097475457573224497816081617501516271423921156538631636088164423975703381267141417729095424886784428514295681303744151740143050267875577663420892467589156855910242957228585177798020126992873396453632633322150674477061295182005467604423809821726389687571018931668662938335764962305651891404692743496644900349863677598015788569121700031318782215774570102276637573701790249075588935395386676034520508508361996506597449159418462035160937787832524463358349286575907563915788227690836863631269448609792815992486023865663760315087967278276853036360928178028870332078733350480106078407750225884312205623444913371577764167702979698428241016393735862442363508670899546037269967781553136447880928733873721851779167180688601724773067179846418314464633890655023952754941478188310518206457938558143017192713631733845018173139483371891970083319140018821506609838738079035140723963708593710418360524614144344523824099708218226430928413591690680142003688320851934506994226914068235240218049819573429908092284360316481906884044478061389809632166896663609407190214325898531335098964867466769984017977434143183810558165248315062528070468895616523617147959977492187399107951351550026330436130415388120917288836477092751984744874022936406916243072407886091522858767953605377606383861729661132960340680346174293983569105196623250208060162841637389467579342149041444781610457248745942181896070820828310050812785312589122987101196495949902514733365809049514590872158577961176664046951353670022559772812774764602676896356164898453346114053377336124518965741442047778489441688217609214000562371701996908280435511786577942354978086123488696121720099513923108389444535098858069927900905798401358564086955329674919312898632660234033002370235217412768610691164937129309822138671269988585194845001050125599182830808349003611332362152579055998831234516495162443731006771897338300178882245240295389450239921150544136722382746210433842041745026388271169883822031050054413965268128799264965186668612978852181069352467231391959737797251386269796298209644943961777970176054978611120915144048027261606968718887201193372782968432844581336651460341104203858911570639227331052405566718892507341768521626705231313013569827274010672371491460238658859164408094821798854123880551409682952950243410484810250586397661961468281087022496258839153608625291718290954891684349226251243802403470518675477746607050919683698623990398432311685596403867325924138275156741465451970238310001058479840188986682418925164798963675779005336933822240151655038299584344224623509024392789996372179082054910018997970193814953131174345488991639411364987916908711159013523253296453762309279888598611827239784176304551272449184694237195070646269857790628480130728693315281731400030625422522263371508462688122013384142701578235769454694688582238351397585031237111744062768998803660305032283907303290633285216785977896811108108568861917703590559962727638405457484175918999263614517993162585867102882411146019508851062136180460007263147449699177456691320174639900343466874964541219727984356747451963635324903448954224342894976669496692443658042165636013832060118437429896932857447758868500208093850413838238654980152358193898973631476796517574122525619150804021670864031254282090707470011379026569709279811968619182636716835173766918242343798784197448163583908247347420645664176038221422354375928657643107801836653170672827962620598518097546312404530496149425839933574603692546433013419602594530308475220118040528501685186762286492833265901125136370791434849918977903101416324990453797982553862270462239767266075496190285006935485195471824229471014174754670214455649600326212014058465164176660213878069605553313279556632716083425598731901013689546998904336261138308800728650579337450823006815074336910037777236870723655403655737637069895008156891906412336670723156462700458507297020649122667202655465690023423043984723022269232238057332601411089841329744648643093087601451077854834440929159929040757568527289359477484072926901373004479156188573519774533638479687943833843565509384431520955296390062055964124945485690738255515316915368703553856627438001384182832142033251940235976406415095326973530805615930952398458009728775817600333535001004573799191022253273326563476767015302323407465010706362158747815395796956093588406578584032508535624569041563262142997510038149997721499007888801605359573608085137174303421099194559590035108887867781692751194714525182638153626361507030721250447434542605072940991260150715479642861438050176680683590098697551896479003628914385182059847429419863521568416719673028957859414549055009763771279296154969893133062189797784019565090245278568281107898944663342143265041162981609651355640097995241519510545490379795810494997015776827665796814201449056481318027997591788800877089452232464199286002372603828832031968135642526400536356745905231622166127854671050930192944896163111059060600956809073860094708411574846224655426325991087259051902717937258480890602279989250911386632847154983767291001795811710478053870735268171510500080308648216726602676834437660311360615459466820316939717894585429689357082930938565091257563294434370642231627600656638595112175305667988024157948142168096493019703975241489953303662580190740478264678308442465461550491776406834876463463762383138342406316852695783881956067922468237539269914128830455944600337143105396994929696003702009785832688141868614977039876706266701112526614643065894466404006171249726067818017855139452680785848534248198042635130247078136037877106293649242279722918147623714065162704946129151828371370781211693029559604951545032735743631008612148576554026931627459637806664711749815315843591795880646039432495948060477790296333604864629768540830921104769483160562985848811840713896211691132731547422392451788331190483485530920264766550975863712232430851660766394219451282553660791974841716788520018529846759581348672207627015306277253958417238553268058475159636137478432141506614841509604930623956544489885733359047017357628637502906052364825013513996241212078767064180182507633232102378715957547715319813830743653580549262231830285475926205320171963356747999611255880883974920562498995278669872393092576884528341227368903921265537177390425843885904371192558916049881936495835753780804456061513366339232716707419195855242919893094673093520238873028809764875533020620917542203293334892658545599378008841731932844211807587821093313222241245385390978975508162063830835926287782788674430892290772850702855749096517326536611286335858749927487048479699880765587128289240610963433106507105246488493933813210702127426803682943153787423118692517219171460231141164873707850900682915644991644623164414865054967040050920174235279203105729766260277444713973652363658732222151706130099975724695779902310864161717431224789202226265656896924189030055620286160097575377967964155150913316942100522062898703364138323443548823899939487995078859401812279440363901789206528402259423928147479575397967019081481716474139694945656473365732582877873916531154972099890567218558538849528323532624934001218575957061026732249430006839540076057387728381739040423449163452838975732267216966354026942788675013942285375335745863321974006944289388838508084957205666850590092128122694542033070555411701924614194098569385355705346070787319657838807595567210148236310540234578811394147956044927512784378236154512777311500478014343678554825191929584844203475110881975723585454997454479847664958867986955928210808909141394115852813689195236610326822092166191892814023245726174799142814474346559843096973371311804671129711455922968900699137060087721897856494559930857224918883241117126587393177076899470331314778948113939494552545524017842536531454939751687468062170348970898607413976142464902960022101849812784557589022268394752612645556789628463407087011443068814668803049679873188405053576642806663266638584057885087519279390857579808029637961449059688280190013674620752365457051775682144497615110635683684090257145577428236035308523521466239265904969201684650059351785780627817096962012439273407297217222311271420234820794977398104859800552393643020643875580811614954502487186665171838272554348755265486217689830445235924194602995364941225101989717805577602817720726326200903036228160161560850252759440202050972716802056070540645471197459029789029729207966362236323366200700305503534465634486154780959644258626393360734762908190777160554506447924026822712057088593217667207150830617637727904128577739568597272564148391438358971597026098495451968029830188190961328775458125327781388577838197254781373832048227945618735306267874208705793183463451331361255126502140026789977547047663996566034678692093060964110086274385159755574171704397343574360948108228837252024912916601475260432195024873113581172897597284493917741518829141493115033894401217028807282887784901361940785843217775689144119799906992501000440241941437979143096590354704039629329526768442767069649352798028391793481471135285660233838402097643265013919734393511038036176708648981212050230248436734215439364076182516080183213051578741159966065044579788785244783139236813487740885743880093171982339696350645647955536661411095859783812030936379263756214449254493729921130062210345947049181912794145905415915772721916489666564504971702556536008825380253897001375088005032951446623404254532790680435554489967313930632190887878113716040820022189042565300973464147809505680404823041389735003235086345544600845824262292221939047673894768563344429979421958685636899900588827159245824954540650456042969208240698590190189219138413876834456629624466082117249030545478362132064382704327355318216552140895521991007928716940772599291409876313925842328814877270137305989916516088521585137947336049655278441065916212514842749780214979987296682448249426750155466941437577114729741784610097409529230002290051346539244363855361688565532838832534472161379197785695881840262865558778371782787617498606915579670913127882104747491353629485775757534746427061073707196459534339063293392967422086318152677012068020214862507544181429459555913284935552277747170071793295880868679573209065811108886474563124887288887101272205652196529659754290751476534224463032694611388957599921230311584819637016055785744725402027112192030810842232748344755103928384164795310660734764897797994135564603114214045399039996742172091982808435181616391455213454220084771799201989535739663233725860120507413015041631548296541186696936918778280635792569877378562043162156075743704927917447967923055612191274349523675316868161874332209322573328009880790062670468108490499949428213788960859967408338642834295666004509877392895152696178163018403400272960392114748443538992449904436865955753002744242060540866487350178952028256181514182307581503080245643289122262388568214080867267419420566571153691370678687401860201239980875143214329117558244392871782063234068756595440743936120645660670992715843523459682048414335682649361129628894617945128653126876849103466670628728836263536755296063805798587880760409298795360988651101668591978013939298941043666919083570940108825016518366935375681100064646192368173307398730053397950639700245478488140726081693364720285376342656646554602885021492501506627016907562665145152056371636394423777060759843338134912125467313594115292354641472544328866627035212367777217842016904887572184492396558909067952605644923216555737489400346251873416058013972975243548292183629375722110221583228397021737413032510289443859268578622184683505896149308923982890166434293803598087094162463202907588203404691773349112372711711906039994217554323285285041959326117293476966026194766105948949843378555716269737385905279606371221865509632959797644901049874146660384556155215966671967811700390808334654743351309362222281815113588026641376018939854343772766483910493979344606704355139531484888217371267843438699597912977305202160772732366300392671782837483169034144103705293531299031117624913480243607832278829573663830284949570719903874096897236740087923731126791244386847555076484080890466101894326211060589089566284210084767534487942182856593780363454013771530159138264303259661034901658119667016717142382146411769935240412078893853458165029203956001460345728987406303242527790824264982910179610147554946148130643427907550044409138605475806915359402692863734864949099533273184359294551265931163526855603560827627105832387925156755634103500951791444808992604529992395167023666418159900855882646966474028918098653335419117406104887878326231493394128322752713135834821265072672946603881024257800310444395313295903296295219847759629957433494745050304682292196628757595517543084657842718259302695136193310032975124901751227628094024436533637855280471602105052456777701113617477302702203276153136120168348352455649147069290329418637519729023752133732199737436844940372228873232503323838507214201870815979193614012809072767425741669280332201341524381921079989410871223034425423596729330132948874634846984246948509324550904506083459520187883325858065543062242089727712100170026612651886514682634133839649503972384170492161013945965249319899037809965629354276748304688486799582865860171315254596452145090607280454519203234046459972685255392745332861028972965022430867369265645083326187326227337389900614967132721656702709974612494224380044999539907506174372186745279438871534670958896601936656993724724521626121675718828602129899780178132341689033653059960302649922679104609751283869777162700686998831682167504906483724705281852765191355783547360549273259172741371410186004264488246902820655397348270966920525879831779203963674978708648566955038906501146526176979050034954900431880818033859680087062698027772424572133482490701831837278906898731615759328748332153803320947801455097540627402643678605563234603350521531470539662905578216613024237073068246726828756209936269032101826727207606749139021240338596986219128512726937179808801529853292183209477326919439511749934516270117136988319493633724713646547965630971153419820090138369081191578377301809954566177462757406412521271169914854061835416217765409791680605156244639507001822256272343862577401352106762452498988987746653531799527550822214271629435576581674020883461347820592753750976647609630942116575312324812589001275332408883141266078634015435159613308640810463246920210378491749422450702174580781402511788221585055842618321420957622996041752500950976891506651151801963178634560965932116906860953364436826197822591286528318482083428109089697933413209544879739120558345748890892640431888233293643684009327061534582863475018316595422607464358657139374228536689738955471918247277620488199050795093622585016760101342466618365092385272240995521581892668629866899911473197284667955773182730054163220932834930951835669499584848634409194997446888985193459761356520045805955257936326764118733005994661284220787348688943762800809815553590346436724877174810712274590601742778602234682630449945436263008964070005167205691967657153066740454161271210632215228720654179362709966080707842700684065246408032312287829654651103826464406511756938065796980997927051213041018292036360733516951809365439150974808592320966372290426485718390724575583071365931863144590360560263665923322627020012249981420963737412997673051631703791131500554742347555614116938863684971139514251069508699748633557210279543805776265609757678212652914753802476975436073881553753554933296541721947204983349563103337446247577640977249589350841698211648213330870974881030172807401529394458170872405595626136054911965145414461912188399609508059215584518995319873728722907117744103711760172441750708820521615880168608572637603626539042121440064812663443742814844611040020658243399862287899671136238192535026570543082591587447876092056669168762846569500993192893877575775776123096162267915449734540971208760558192112979203697132799116561475720849955006263196915076322607179015113323156874803982249735941087126923161524496670200910946969312025049086074535724107079104011907816853317768781442870122702206944153469466631854870302607791713974360028561760658356970971757134600144246524991661909913890006662099704012851306387231020878915437381071104601309166291863325807353184239172110824192180988856732093305321572832404291120720699338174307549225300687775927853907407267323595125956765932984732595115207221190378591367776824508826438363129613559795981917523472059745185319518881499001960017433523242126373600181585054605664420183296552913579809821190058929334482127137615150003011220425573039498392131821828914065150463466274099132477420653301335005135656115587367217287513653622608811752559554961766584702600980614913149978612221694836711022926093184738796563453604320353503348918334326552856597326512782588869214054146975637797170561358848060694082972528448619580787932170705825319197432221393740693611836228748400549854799102383744060818646722040144684635505951559737855897255981537997215521348403481864399005788069680883873848114453457760581863740303931582800091704532133695615259258051636883446587400990640034721654728706266786372411017777177719562179968085419275706354754591239528323291427589805112119093253806974438084050940838321114727400780476117638099002460224944762014010577798012438827861138703242821337913507852461042488915723742924515922583910516142530527045703381599224870279330502763379830699199223975084296967366641623990463998473444830549282646333986227239336747156574986247142377820798012361040104581010021784157339264047745466612824460390449909418722281244508983963757199508543503615229798460884203468473461133321174249109859912612099345297881414753008099496206417435951801750913598118672213841257708194411129329061556802395912019906150878635593837313294024430202314811083148729175047504806592997432937762855877998299986417852413086141015084039278424626352652097636203724064423417306714516855239084290851392812860385871153706358766470387988575923494352205539618426925707254329780988552816845579704306831881126953918952927437428734203238975497767927683241316647123238422692235791195299514915319565324121275766119073130552205251869938859555434781920370597240497895216210376787849939926316909034358186409856347363406942571992519722736665262815927414520852917982671540856119954631800518583779652655428058670693132457614469622923386871715264607144722483883887942265020041213313480049533607835411572831716431283314302385237729834460398182863761108540498903331005749557265747573646780266171721059278011738940732096128241455791346260471510881357190193571466777372454266580885645721597464328975717439655713678369696820040338837760082793536009719856381348688167590783703983908498190875206329396811437182288415013143647102373980523461580366664957706676857690777170338696494319621251527618066105629042844909242327680278972412018246567613167944233124002273181235278616336221553581154889416315445338387150827715165620765521658553779469772818839936773620032091052746194738138475911534154400223660477140931762286505198668183922650155187260605151884204158160467352702267895470932014062046881873900927408357040010854009477871038650757544179515872265231569021850348520087063939248037378180589224337868284849073090437574671703892497893168025962873623534923064056356936928457956085687719178651465201339716960148911889644973043304966597196889242535058584901422495717389132230987436026108339249376321537801445730076638882457788547151625431284847275534758949572299015036881495247242049059234804759407916364996755986665180996256954849617933737259527491615631195662582711832971005362024909531476693231010525981146074850547289119543156830357459298926584334781418308465202114998769496169911653285950276261068683826122887140480276126785657581514870820128145092199716828692216421008929226033006003971001817787768026640420286798503120132514527775623206484641226519734271166332728767498350143794528070795233341965066740649181804310259618694253935751615537989237181397146836880441051100847744330092395564599059177949664114948914874177241446015307094579245677705256598720774162289113097210350115818015800840585399868028584241971820451100028295087812750655629950564845762111332308399525421242885130963487776277433262677112960482089985685773322128515237150431088946511878377025385056557012795398720328882117674875375489964827436241948594249886751019259027238575301063063231529255509447262316344843294041048586471891605816403913838971472892182664169945348510595193435680799773512012300903567500692217401735055608349475364942107945189742762960984099839725465432681102936434894023655602322188855854220733834183090892469618137182885871445991699557368540717216629500267087647597692162034237229667484102448930205749244884723382825410097676048800656036050131582708202308036411211169823900487586729743054522168155521070435255138613132864376065885576481552881827148419818354256119535808263491311614126031338648881020734926303397844039836202098532248739490193651270949501144889891749786878326098609925236990156943079086435264640264776531969040744840857735732675760839662637846490004120638700309557680067232393961039002751250884261766484442947730555559620593009168029801857926871508551066891208972464126327079386169341711722109620348071704290218747064764130650849107794443197907866424578077221117729321172541680916333146087174833629324701237690203733690072762634064353723596039885217193075983598599880892821611484206463960147595770768353622335283274609297452929451634755934620925488418128701547643616447713175543345425091698924480437695562406107444288965106708126301162930276900763126730692146433456455566954747749525600369544322085740519734095129741283353542857345121499983192976757920900967086266153023916462069572767808213784902921878904951284606214473726038477576365440286156324252585960698928130558583237694773607173723495029686556913733481334234557620468853527161494199478284441759797937586225695710098913888230837547292922235592595242751068650691474203569441412899352132150162279939034511793442389433183851799509930702676382554283094385619238960954899008944746276763137340206568514447585918838518787378437859736986724893975711381627428523896161601813365949665690138394679725437770734179251853276522256132467647844188019482838496633510664324446497724961603248287822478123218032125539485798734833312174933768221373936890953597306458279172323397052271766571335946865083745918780392725404613378953358265995705527504514551018293567468511820901807556093213394820150572565707643798992461062255831163213772263835067841264323622260168652962904477063588872641074098998961997492732414836388908265683229530984370929123269261083924781623156868706989199466148585906551561284384991814576201244444126467657656952700984917949677676874892571346351976722879104430963558274813147154982943435256707749117811079746956411222747634222262912871848167058744972030162892256083691566205514426172074982008920104178750002756142587928235668036400322352825396627056656272219389435205873873083234256873571711140228784621388106685780120440127222535073905522547136917834548688578576359351761611326571372702892623770184748534841139007948155318247332827635928043539461846218390321435806604025146833585999237821978752270013731549462860911354706047626222338763975725092135463656274900564039612782379145133909155335370328962916632133267118227156420219955009657592236091935418053124697188764952877565359416393352246755926034279725533736324148662977707811710690733291761116971490731498375027764790657239116926266432875382216124633433602970391016699858926175094601827752444201867413594058428456165005066127775236576676580738160927442859488523847384894735329124918522499090988146177196369568756043272703668445311613439397257221982534861493108680548741735511985015394865404030167369932556743872861286610497844867688907527296374744603459838971958011562731797807301902952310294023378389312832815907125938989219821267238941579091216447575771376688831458903417568992833300824620044328709760209285938847375555027367857702047831497851215603724321792493303604343849470247548147777777701213521017565576256450985505299030049020222724138854901720529163221971425113351119514722777845166891558071059505642138238309713727956217310400581450898866536818193334458280765676720109006574105145671077729403441620692680235111375777853211997281851561900112074265699954214871212239477786492346863295433624410991270218523070453192269062105511282612720908830784665080344309420838315790327636883720340086207115921651904137653179567695171126534564884448440583831859445689582554307451917052914840540149673753116396450907121330583738607137577200001293062567146675082783341877740923108738805712641464349466424768335429793984051876759271302053335986918023631576692191256474601612868301200384815760846100400204735784205210381791579578685024582545057593301343264581409859907227974028899015062395836178162566878274573270626275689206708565238169084389625438185723902033567232243842562497548529600636108112997889498129456486498451204295176332861939492793701647928240218647613241642829513132658428910697574892494582738315121848957230453045068581499728074896314169046925035894051476386875631330475725202785789728703195008975199740732589672337868134750792729690311462129496334337861439881064654021944025398168609229354396726105312412667329537318427527993528137087951699842328212882694357099612689501751264855890232961039213177765036107376443426170123848613823830517041305217382293682394191651571321733563266219624272350666616595775222172496285098478088121972856802440284361746688240427943438585577945086512941896213950001703503911630958818036826750506975468968039744951988334184885120623177817006272743019279813452993315684285112265252258399776271595879757263364767899369263725879473096030098920956318485091272534449813174245238192504850279746965985582477375882256074685540928922505716161298005018242101272554680157364832714643449349715775689454074016422244181466618913878786133839720612939336347769075436138883705011950891820868357511418970571775640308905544448571833090296686241618041868363219379091693040774575037378761991095644854185033746909085688869601229985190225623570174419223683047234585355513072149302408262000879536703236528071975187335821976452427458958258504922224109903758989635436559775588454721974397552166269725624678828320968483535916518004526705431797446916766212646747489422622907992335541698544565753871920146983085606177812653664609958071619764627720324605851084957774094132673870340136282258933801137132635300903236464079986383485898850520448022555633124091314174818546936570438799816170520821676026030422956665348589389046922086426534747280202965082365818247451899564657854596048314623700521437578862788088094340032428610574500714725073923943709514185024584146180136543614717839194741580970605501136013715157064932944335573721248293358903735637019717003993049693628207779473612011250843472396434133029037729751045552313750474892294622628891525052735084056061781169071484203335791417080279333434565790665765490609974730969512965653930313939272007476477544983465598484783481455828814481426652690973233518803789908936172122475041687649787357702275514155170481745234723360419231061738441247538334564666827079688067780775631835178435504394738085364219913026735187014670605112156521491934920922532071280028953647681228168439630707187219426233495014993373787410080197903349190597345390691964955640211588194894646508717086429528660386070189900109153651092813439643270586703907647896574915667654764083884808632440336592442096959522982035007375455429955536799426317306525100907495973945382204677465414439586249309293502416998366840739634302829350272964782238139619065796989841761257175637244628046209655012946321133881126404396535892393599107298918333408857125628720698893907727645010888319313245540994909940570919288932706400760305725790477045153244930958801832985178862878626873463587597459659796435135385996362641799983755096307896560222697397714518613324186610490353323733056682654796337947176227990116144893284051005583405287584001268501941174703361822848092669217970145515096244048976417187051945664098539366328458873057289761346044437290160454460249010056609280663820050579571527368568805286354278286150454959413934767279813878202501862351022700146612468068633656852389276162871495985888072879401313449082363533705363153899243204039475591736414977394364712669531101536452325830253832126211335913998147254731088561103502523150232260764659143479577070212255923857619651541130675902020771818471255444048094317583914104182857184684254356428021148612817114059931241855097230094836718158216635032352144301276029408110483083684033797276910734947127639485242365436010121611472601302712302114936394618640713323418155883170291132471155668517400914663308941679541388606459041308602475814809253881136334315220213957367287804727138375085893419354244464347169486851505717320834190054678315225496047820058249682459499423860216615636221511785277723734839254123719912398519291223166073953380408600317855535616697152666159714298093829640817484067595658252229511494206329027779249773802025863049002338914339161519730475496173930034909831850312164452992323900730390224074960970238606174088433933033116621413766889370324384494435952138468815104628978355361643207570463255409224335023740400655662384598817253627657820515918887137428224533698114375777755070470831999858049255399615577688353196603888411154532510323408417668685656064533645932582928561534870050036225742135675646177049353802796329267220164454445475026639009734156461408161237802378693542006719308703239489020605194625691681219163898897868246791575908260118074941898215409019644400609858251539514525840505405733419715524119332247162481715869590459607132227120270750038073415057285273051413461724364324350759083064442511793105821732556350937000463861006031635526626081975615057281743286197573113312439953870280147398646481951044043706171345291375172436515853579700413959268525998127206830937440974827426549100448972845133920884290100392354174550892017405721341477968861838150118728784484229782013346708946882973957166350009120024170327964084767582879474715637448850019020912066997357415500918386337344316273385635359478187486231891538682917624634816247070727154605269563573473480946626498924617401296277765764623728025927779480657766730119544692743950126338678444030100649194269469957667185565363382615662324210286732044396948485770363843327964356245450681615513771880359763392935479951262966854820586892757707754826468364824774254559020807145925453009353453225487341641107976962272723879767243025919066038955071383136691818152342825205396838698720024030663475975605134609154469548162387425378158302653098104742760607748290171664036336150871497476588172192978853908464446528705641619046836523612432367732528674613688684282872712218847056520735270032365972755740237383131307183137426933651450657979976777726799881447914358583652734628844838133347320253032562039218550423745071246201702474289175965495898199655426861179406034823110616497789765805879019925874069554366793037911629180282626336505128834652109745963364668600722087891966477672374488583609530207665510278220140742685179742262555195530120108977140157868272506731574046078508917622773625815367966375862818839152555955251613018703144216909288827431719952956153271512085651116775294542856160716086003685818294277547141318914905593218301506196236101121808775264666512306459999615933951176549704193364674478497559809435239357666243284437023988696401177364692704574611809528748877957078110501719666214766418626949735746138893917281555165412641863779432045863818098406043470354870027768855685015445395272991659315976801943009541965850172319561870163232017714943145752454182789724144200910922235877784762143982533049141480551884762764035237769794587133262129421332780056882892714132334279085669544052271630773613222223624476492604444925157608167205125791983401414314117462430350958588366449885635241216735096498110886480454556121486157144398897012515745641666786086974599235092306913787822489885741010152307835427302686702643076573361527388044793980964034533893414269988016666251433188572227755985299273106746685733619787048404116734845406324070562038620208792937068210443308574090272915222256690268914154418055934840966397852111013396317334823271359536191364785487924262667118227265433909164704496304973642336756093387686017097896893746341790095852105996698311184947184187211471898960323813655945633958099118010918898042657125950534933432590632358450814434844929283495242487228534842158559858227162257611210612276943587121299259340778966149794293635945828339925529844938205488768791335589322378202474504684456545675207302749752781246295549575961201910351796377991332194760924906812854053093940777922686627236493385363777797775841839985573147572508278278133424401285982580466473015242013987134640272855003454864134949658500406325010032627834898309246405253515128757565780041454196947196829194129125382322323040242780772044913500813181044059147935301275937249608282170902630073205555942055092241584936796162684784919911479278169140343465155973137653133769095915408557353221970821520200012878529148624180724372726554026068919977669095929312884966544823351307602582047220179815182981537115752145138942540406776414150378261542887352743572109269918298733784934925067944884528014286190663864893203832262475585291450877811812606609287425948652977367927474274345444494299917920010592825788588113902413233669323988364616559366434889317217046632974698473209548716538766597259787417373930873958472547273737620357931162811189212024790071245606469357417284761827083359348188921482659253659222451433399363951099458994696946356256322943123704715769176584334385021496772976038499059194240009998943838797082608197390942977149427159059509449833904644963958202273423071851709842599767135871155365317731794555314716713826977065239562572301017029691252626488197191233757103889948396553423171412191470103447526027865609798213571692749883016370886297798018562692270340541981638788082598785178596072450292199365464328545845537098344079433001582732447215368560726924499924496560890592414895661596875510475437876313196604588788445159012313418329514858528887605451799863092365858284379784336048329938764878904605287054107746539136015280698825897759306969126743288071527820619474346504546690173027794183372811515486678727546215387379115550722143800612230582630841490858633187051228683676576287111524137827187928358183112019706088688696349390736783165658883202173568093943999985504687912622999501403710446795445902947321277458468364057512251147621689571851825122939713687690034964094187762776565918785051166359770911611077709056893042232586633880423332641476369701384662384172105006157634901704929732854275295654961204015190472324601956711162863712879382278936420806227252391446338575146990663577833960269166968095423399522369570065424450232261096844773919834646255336098360100685095774964533666208297222159707073618423201453895130160080791291134744405932067551763295733958650556239133883104100736158904717574756529573433505140903826999699603607039261188627921921196874050802238921046483609662032780823943745532697338678333874962639215512698373936532607451211556697184835766320687895642282136622715867419516911165836626866744045455083127447812394910099323884790018944384080848875050517056179744159971295571413750822633140320665846277239471306970143937789246958168275660874369056961391946014632458426105667029785928612327249477805277259332199024776783298212540205132110141164448518460584779710688655848291095318621147278146482111054771441916191172" ;;

(** 
gamma_of_one_third_string_256
*)

let gamma_of_one_third_string_256 = "2.678938534707747633655692940974677644128689377957301100950428327590417610167743819540982889041188789419159049200072263335719084569504472259977713367708469768167289823050003218342550322247156941817555449952728784394779441305765828401612319141596466526033727" ;;

(** 
gamma_of_one_fourth_string_512
*)

let gamma_of_one_fourth_string_512 = "3.6256099082219083119306851558676720029951676828800654674333779995699192435387291216183601367233843003614717513924207199658915240940225599774264588903614506064137448968541949992019267730379946308922124123183237079920843973699070939056209292323428702741914486039571368350368654879959683684764758514890904041663407630339718066805957734237908559080714578312976356368825587928811190635168158508494748815027886731073105248798251663661287931641844174438276457548009199147768019228150926119943229978378353634595543419474" ;;

(** 
gamma_square_string_2000
*)

let gamma_square_string_2000 = "0.33317792380771867431837613635524422665941714024962974315083333800226579369575666966126326863171597730303956560340239859445266992699598365527983313786046034268780373558371128830975908549888552751106825808280078552787375606684200974130617588691178694315050324483702760663422216993421703577153253600060741015276339995955943381572867437578342434224655682393243470405850320136057784655662305806336598738504567052000302014780312845447665262628245409059368111793718690365391787374644136628232478821575207439195083023003582529592911049416405497804079735906414541071473018833423728505726964936987752237826402067444337399595520475012288526287304305672083807917820314483332377181367931160843498881621249228779170420363188448139000587782356093541658303906200570835173454721355359315749772478567570824550788178469027530815855753394890223992432182646851222376597944082250651535911750795209885106735426727042416802208197237186718051362364187225776476470637129109290590422937316034959310316334478259163645260184821130314905132228424515350718917437096729789431293384160628313117664130173704083301200438871961377714361119697224389714966794999085492494451623705625139833485599878731684805399265239678318576488579463179229662150505567200784546393706439420057318174508184490004029944723412825377473700716194720015430484223559786301861306368734881313371882248317461331182208906680249105105177437367317953837332537628210518958414150659594781665278992239381206263980968759308421024899927860428325296015100254083327019038389413937463567795591719222262167354922700124199888590086508057007138340244455586691192098911631143303827436130349373813083644429999583728353369352017064252566989786567296158684564092320306564449034531271427626316480736098201513997004646088266563584289225772605733841988691095309995814940916745770933938681533882829140446609531584136533622731814962566534978326918981782082993418034436561490940423020354026303602299616110979002333613709999437631985392429351407961444985983615358391278333538703785385676286" ;;

(** 
gamma_of_two_thirds_string_256
*)

let gamma_of_two_thirds_string_256 = "1.354117939426400416945288028154513785519327266056793698394022467963782965401742541675834147952972911106434823610033058854142261552586211826607191148114322833434155915620917505682592366523385211910858011501770153617023853945368317754599736504155930691384228" ;;

(** 
gamma_cube_string_1024
*)

let gamma_cube_string_1024 = "0.1923155168211845896631923744196359071216782613333752386732529125391788449161379359373909712378556605116509496578024977291908492298164373859934521354342895774228854657603244420668845733461466984980956808684087164403574160830854272309254381662716773107938020039994242691516605877927353795713408781659973767282630561706605215670927324932140129006723105172176628299988893685112472292743584559031994264520178538389289359085058717816206325754107251397818983755611237915063614876091010439025903441746909093701297132635460268766413284347690174163177577708123465641236321786347346126157474328371599806022486308193873491864684934714503323707636189524763742059550716445670267597515177974177262952966946440799233712308611536364444192962393810142627959851478717342890914046669633914611514282332548025647156179521090419510855485693657584677543770862809885157480318265948335124699603200524564225317702620433216151437909259697255537613427269477220699844084228317567462113151264588753378385971759828927564529630137117394690823727397365598808" ;;


(** 
gamma_of_three_fourth_string_256
*)

let gamma_of_three_fourth_string_256 = "1.225416702465177645129098303362890526851239248108070611230118938289822888426798357237172376214915066582173380237588033163016659032961039479304710255059983822777919276890077651016901455331657915948759445277305159342900375786380960492388345759811873070193570" ;;

(** 
gamma_power_e_string_1024
*)

let gamma_power_e_string_1024 = "0.2245172519832320626651282937439142868095817465731588729997644748905927584647985125168192836257270820973038172285783338042117393457399097032985231243534091872351686364452812432201003708383095335032511940662616915979858055381918901964452536684405613352638050399436141231496021499662822037077096956257950834279457270299126124033897643716493611207456308117119091112022227513836300407475748834944507089201420363136350763608943998051918726135911137450053480996432518130230287714810597857577770677840741004009577960809617859657349734765169700765800010907309845564671457337645206241099949323108377411602060701252771336220464945276237753289326019398705852534473224868039043360298790781601039924517676965488787524987913058430190639570712098355032989950638685649624393419027123808844754527744837205778387321125447360234844247402805351154917641373056541918555616603267299560638628178567742314251291215363856705897607028809424929280920513263854732392207049870282021874376216666637408623398679387192085271785645752373986994443040623078909" ;;

(** 
two_power_sqrt_two_string_2000
*)

let two_power_sqrt_two_string_2000 = "2.6651441426902251886502972498731398482742113137146594928359795933649204461787059548676091800051964169419893638542353875146742420314383674078186985054875748950831147839628583561836083461266431794091489100534014373950342870833119045271169737315956529056576328457297981774346372848330862819349528549927583773563188830693383234459611805080976879081261274910728976742978426637632502369601695624881711639702926903859903555628460115605232024465006631806391529947959280102745500352847408628685697748491775145744996588372975745725899906388280003508036903733879090467182805383659676795228294681896018049344615328808423789947168382540568693719973773623543726326713082085669350247813249584441266170431183380998258190363113378957685095232730797115780607677737672559957796299769439384975413846210683714037918940572046075515482487463115813270055277740580117488694405652197317909350581370671620544575999859693906949876978769247287723037903391158915566420267606097113568152490853124555456599355741761228151551680899339284142161770232062626842896876281108354897870567478353447994083334164280221005939665814268099506656731699682085700857612904437186645383675046896232582721370112050740502386252630389533268325697347198943234550477641417747497473252987559073026395876017811879634413615303763505385762659815196734847570797396637608468720047344119580770957940634323627053077957093296260478199325554149573588752687081621624236506589930746778556987975753446508559720699750219983091077608980268862489801452899911236684871179874279954411637105880602110171485781070632949664966383211861495485877240590608092504748657763832877253295432068289256776649101883658978959997849718819652644631951910159879232861820961763086731968735658298762079274371471703151308725777185995258140397579936758760782486324489438492126898947226536445638549209472367778232932556878676532449691522697937686003006888480147654028470526446832672538365906814675431912844507558089096325837811183599592847614815274128432280444427943751270444589333595911610552128" ;;

(** 
gibbs_string_1024
*)

let gibbs_string_1024 = "1.851937051982466170361053370157991363345809728981154909804783781876981890166348358532710336502954757701684361648007157009372450799901963934227232241416503636507478802775776040700542538704594703754807001254912619600032707857531260246278128015159869271262515665803781917065704981911171421538301728686909500276689196983783564878693375929431917536185883987328136153711174160053365028598892890641467009548887738224711295573667340663653320635391760413517203911240302891135145131838613492925774418240752647603090527920778214856022187181490425447150146363584277794711774661377560583998081360158977403570034140755912037021411398700597496445764243279457172029791461951458750055212983680083940227544078733718907760023337859174819734615441535401375520206534953637077479723223530762771110135468092684117246271430826718796009174157616850804644775629455962784638180945057020631510834608629676115838424464233139502651856882443995288504068180671418260092625808323715322324469000409192428978534923839641617493595572724049496826955294684580908" ;;

(** 
gauss_kuzmin_wirsing_string_30
*)

let gauss_kuzmin_wirsing_string_30 = "0.303663002898732658597448121901" ;;

(** 
golomb_string_54
*)

let golomb_string_54 = "0.624329988543550870992936383100837244179642620180529286" ;;


(** 
grothendieck_majorant_string_1024
*)

let grothendieck_majorant_string_1024 = "1.782213978191369111774413452972549340791731909773239381024959956885154128763784080243167663578255308934469165439059024283200723716094662412246981831933044406915808443008316235214850592251291185032205757091260620528266462450802768645378426168771943578383034597894360465417933305816703025504797814774063398442935551259739271318514847151994642670935557508241467848321492674197831057167228768468972668325299481120507392284163942673878597000697791104289848780316299969926930435119732499871017876672717304586364851476047016593168881149307206506607114053361600266317601706808545382659150318190903060193515801842051584567626640372089564659879643577248838932543467091581365808982918019903728678279761704675817233755073407572739430070077961255182108978416615885305943496945317816864584734664771038367942228085531134516968772013659085159554971003370928683531229225528650295274335655466948190921977647620671768178915755444890119084915143312051099013514704534414534327876416367319236317348475787753626711408551283923240403824950905050799" ;;

(** 
one_over_omega_string_1024
*)

let one_over_omega_string_1024 = "1.763222834351896710225201776951707080436017986667473634570456905547275847186995736789083891050681105561933002027405468046737640024013795205738010433926733023070364975296754471642743743039017416565384005522095243453556698266942639558302053548854145913508208310439364365673661858704333157317180928709778981095416836375121157747191058764831283113714339445226848130120182098040379440425687558913817470781415827410676176997180106117658115344871122490403839481948511751182984312379254019253348744261849955335202997789679128805119654576951811977869479208432822976239946198820948445814099680627550392429004489387836181076871507788319467266809965539227711252825593343096958169778925518964843270078715400186529667283987339048579560410433332561918924461991318931465019927694927970415858853237673525171809006097427444281054965744837481066511899509567826547556335922225540324340882119788565273051892492596174043757408971802396981961207872184931196292169372973656676024276468323643137024181077777851246850400311319023111832315787739592779" ;;

(** 
omega_string_1024
*)

let omega_string_1024 = "0.5671432904097838729999686622103555497538157871865125081351310792230457930866845666932194469617522945576380249728667897854523584659400729956085164392899946143115714929598035943766984746356061342268461356989570453977624855707865877337063566333012384304556354297860850901542908192085605575237481965846595080727308905015733618315960706671080392839183601494996463493484483174659159336368933680971490856983717510093546792166747552889731475588925030572822460486512485410968831844877043346772701657446476520062701336049480578838757749146359830348086869856273420991511983061302502702237292838727216542426572698430693890685874829642167823425504200307196679522089559093691334395005115494954271676878949470244383033787840026066376090985636458287878187953383042374755556969754286656135480540090110477123732473016808842009334259193374301935466235307656727097576121884138599444282800263525068444752559622506113878481289784276938804729202688892385164847534238449539027896099711060547842212061361983111973376227976096491011771088137407049732" ;;

(** 
khinchin_string_1024
*)

let khinchin_string_1024 = "2.685452001065306445309714835481795693820382293994462953051152345557218859537152002801141174931847697995153465905288090082897677716410963051792533483259668381852315421332119499626039328522044819409618068664166428930847788062036073705350103367263357728904990427070272345170262523702354581068631850103237465580377502644252485286946823418994915730661898720799413723550005793573669893395087902124464207528974145914769301844905060179349938522547040420337798563983101570902223391000022077250965133246044443919169146085968234821283246228292710126906974182348477675457348986254203392662351862086778136650969658314699527183744805401219536666604964826989082754811525472117733031967594738371939357810605923040189071134962467370684122179468107406089182766956671171668374059047393688095345048999704717639045134323237715103219651503824698888324870935399469608264781812056634946712578436664579740977848366204977774868276569708716319293851289931419951861167379265462056350595138571376169712687229980532767327871051376395637190231452890030581" ;;

(** 
landau_ramanujan_string_5000
*)

let landau_ramanujan_string_5000 = "0.76422365358922066299069873125009232811679054139340951472168667374961464165873285883840150501313123372193726912079259263418742064678084323063315434629380531605171169636177508819961243824994277683469051623513921871962056905329564467041917634977065956990571293866028938589982961051662960890991779298360729736972006403169851286365173473921065768550978681981674707359066921830288751501689624646710918081710618090086517493799082420450570666204898612757713333895484325083035682950407721597524121430942470953115765559404064229125772724071563491218723272555640889999512705135849728552347645942418505999635800934732669411548076911671455813028066898593167493626295259560163215843892463887558347193993864581698751045893518777945872755226448709943505595943671299977780669880564555921300690852242867691102264527531455816088116296997029876937094388422089495290791626363527791432286156863284215944899347183748322904155863814951281527102068249218645827978145098870379211809629840943604891233924014852514327407923660178532707078811584944045092539519718157085780907690772192962552262890529967200510669638584207655081660527132551761150093619010182152039541621744474356571314026496051480322439134457528009739604967190734667398621127034770623094786463721777245551191609693349580116501538146897732947400254272699518373881294004390465050310091210361980535760952228835847669743267507757379848939356645406017251962513826671863828822629657399438626453078913514555113206475947913245582423662405126070382560901984614575152951511943211356814416716008974384391847402590826495013602834007260634108659796382596784136373377680857831279147106417370573337040146024737648200768231118490558678994106995743922457089666910491534089500139419890965785853368531985664042350494746329804481593573838687414276915611134778612290893976432134279879206472381493290546264824907766030881348705331723336407298994245656611424036824812873959790915799781062723446426357233234127834780836022424212901203199698485951429216878840715626887034517436895639117072657935407050794141100343395582796409783891583020407548189623248280478295465239223872194333981851251004747915658247782096645428132405620504841629632689157664149594957463505689486587289243413739100608393347108455293656982935338521814358746992934863313565820307192052961665775757266627408455837127946799180904710259452519968016372631267038023447298309515688684101430849594108797807013561524049847909714362331059569179431431691402111049142985963053516771600084867260895318575293282183754558954666446191468252314874744996401074402664686009572448671687582605311706563448494800841013235616345298355661883397936163440983329415351662473668696589017509927510426179402465228834883071274736258665127650610546028964911287287862738263596129333646532191462193644375375986052224103348422135461338128126772131245890101073371833507228401529641174179963903413664423919027895258486882959689695414733771140886608735962775876801352400029217923528552903064508042269791458998101532140852906522851155926562268843097382297291671643980514954868377297117263777565889196871160509021211371651902341089659293730249465771175004282806372542711805610086582199353671242849838516132864990427711284071698787833006397284922820344349455347600218003759357103205064406756731817833717035278315824041187154686581171864952708996224348497793884832819497863569163437333174207210017054301866996336546345356688803248528083754492545177937909480719571292537184111634137303745351158808536058387947244006076177381212102789234193301297654667548505996663777643498372821340898092902889278088428356657996352849776141925529724571724867587136418201398244839217272327643398650709245008820337499415470402244860516920495403808927989711051717768667304408545186666225235192118021635892919167850976801426649352465241315279351720847405377357578042399840807239581517870192914436593403426041472365945332028684204462087017959678507105044335899885299980564606846787225732214957985497309246622145607355305369122171822980735330797038775292460178947026111522360709501432667888113281990837513268845551510892190791002610859910028841896531906865518597376800549155279239015601038178005539072818968126480022740306581014459893635059496241529118447243731448964790876170326036539290133430684781818206966837601732903016602762498422827578841548456314713744987325573405808059688168787542109613848415947550297583968310995807378723577778742169704341423897424468452868147350993296144684543688264968869192161649670355650366847261236344317060911028964507813116327249011793664610722979820574075779145800908301060913216200897249373201032777744785128764388089981656932715040612090221827393598823187046383122896921216104846546948319792790320515076726732119163218284371172036046713301772401534216569368578887782115998981797541546286000230716000159982248277212628384883047943066328546836223944311977655842794918993522521563237555650145286211059365868171399984063710196404159462648235183782162356589166387664599049458627927377620486160161495004228978098646407047162007645445619312738742470000474" ;;

(** 
lehmer_string_1000
*)

let lehmer_string_1000 = "0.5926327182016361971040786049957014690842754071971610710995626081582473523641600085106647842971012570511871834654238696349260297206760682785607987197943748725140340300058369248691553864061466034856682341215484563644664283093780498006899118318496569617201211375947062343698651457715202867734217229580516823444477688944508054163206155851232362306437917022352078160366963927634271252488545674262839723419486114155544111865660734792387798043466342553169275392299736486348587121833376712533276555297652866612606618578871362294940308903198431390795840547898950994700748925005365632969001766440856359838520947830182186895213784898496770578735653738549759352067229860393620752857617751097879568662935191278445393356845487461466799368867183574393737916590843761657041579475077620030956011574042760302493993921496419367417172065429695390317552695153584343956727191519016888098171759724906758187355999053854269057589569016230717484797270186090849699968957675960828498381969270404195036511309800972643309599823665" ;;

(** 
lemniscate_gauss_string_256
*)

let lemniscate_gauss_string_256 = "2.622057554292119810464839589891119413682754951431623162816821703800790587070414250230295532961429093446135752671783218055608956901393935694701119434775235840422641497164906951936899979932146072383121390810206221897429600856554539772305369549710288888325525" ;;

(** 
lengyel_string_18
*)

let lengyel_string_18 = "1.09868580552518701" ;;

(** 
levy_string_1024
*)

let levy_string_1024 = "3.275822918721811159787681882453843863608475525982374149405198924190723215644960355181277540479174529492698526243401633328189808511503417099708230466465646703708071290224186139594237720129817924251087697614930028806824926170594041290808697054441234922379888442708972691640983553585480483747858287625269184450076433837038767418844594203517000037321222306241936013409165748043544702217325993822298382263233915155285779861204684944725214872290148093612089045434209209951997816240051503905138153877147542913930739461780455278382777274148472215134988266729112154482704520186334876500197461804182629653652880116815110575135087115230163029427488336462609936289660633637763172165088348019361117563266984111467571646737885366090624367033259688737535781426541959925075527820545637159407017761632115357055923392379438429270901774392301637440604126784961607478309902996805608336904790923233611103492714737900525389549165714734199722931676646307641198327646538816962046346297332994286181358520050377154266892424005731518557308952871781294" ;;

(** 
log_2_square_string_2000
*)

let log_2_square_string_2000 = "0.48045301391820142466710252632666497173055295159454558686686413362366538225983447219994826344392699093271559766135889748125512841335826850317755529488084429083918466479889640433525242367364365809288123088602963911280715303182661763796098673082702453105925226656312820024956976451435307963064082905548298567572314978510155867910849608390915193311084870624052845434182445492796725716952952577112359657358801041335486474970435268692388583338828166487908857540975096649723158050786731973450614471200509341451651211862109203508748202985578691271609236429867173301844624563281759641081926635865778233923697428001426552796882397958699081971291893820699930825839343233464154340966319873368980954169096883844669475455105834078055480402621723577305762889765443344080058548975962214119995192270879454946813913700234932649350986356999460108860298900645465619378210410794978760457745388343582681206074499441569171338158390742524789445815173948614268602975364968994533565229182173888716905266128207010601191677397255402480756248841017533750114667793807441522051507737288756300106495195566095982819853197718427233204358653582673030819925273550282782475835975021051202156925695807293114719561323480377325289297137716733902980240850280661658200161208902474534456408020708391564466394074251782258237392673066393349088630941472195142023389586745687155804449158357836503410995389549790766768832250176230597517393677471159719441479083953466637902057135006471738221771003656262750524725740125181133520413927493114167990581194158219634131737550551497740716861951132459145167430824226892920380483557544751404050461029915092336083146207824608201177405271530386414047510596432138801973441847956220910403492441981420917492865466428695218727873069462991782596535703111962746013890662738693072095637923459636963328544864722713944629064010714484517585123118685587273025311551324838859175961721429578102705178803700774249482144350081547902724003849735372234169034789932632165255953580079452806705485149346920455794828652839542437604" ;;

(** 
madelung_na_cl_string_1000
*)

let madelung_na_cl_string_1000 = "1.7475645946331821906362120355443974034851614366247417581528253507650406235327611798907583626946078899308325815387537105932820299441838280130369330021565993632823766071722975686592380371672038104106034214556064382777786832173132243697558773426250474787821285086056791668167573992447684129703678251857628109371313372076707193197424971581157230969923096692739496577811072226715205474090115068915716583082820050184892117803134673122964985828828184357133159143170054956325334887536302670425627486948438002800259270026847557436497550492246136239920400157506303972146648111512373640102950660119390467194373312530445102911514639759331918047977946099333746429426562908969344779296885419044079142558327219971840906746802376153893544565503602730285440849344302806267044182412004397418676617724475639534442306853849527943580751895490309305073843954464206438717926390780392074428209795791773699230408221437464566804310569266319755045922443248074894080624749361070936309149224368986933140903796823240790046284487394" ;;

(** 
gamma_min_point_string_64
*)

let gamma_min_point_string_64 = "1.461632144968362341262659542325721328468196204006446351295988409" ;;

(** 
gamma_min_value_string_64
*)

let gamma_min_value_string_64 = "0.8856031944108887002788159005825887332079515336699034488712001659" ;;

(** 
besseli_1_2_iver_besseli_0_2_string_1024
*)

let besseli_1_2_iver_besseli_0_2_string_1024 = "0.6977746579640079820067905925517525994866582629980212323686300828165308527646411129969656541826765687239828218773964133931131922961195325839482671540233685720770846879316532596768026096993447735279134807392866925472877889269341631325163541360922351694910777667127019798991789043551299822748847417815118582827474312800016883973575031589630558148456722812773785313893537964574949111443995739496545408641490244407439658462383405191698214657075454152356161978927702157019980844153256948432472055320438254601089536953956756141086175951613153820732931364439051157889913997941184531707255433214244317404753282387468232949778600917592531885601921774744917302475827510588530039799891961428677298872920269118479725541584489103832653246261506026959580395171325335518290539864261160122414588261244351825022559389263137501312747096674905266754096536040252450838548835894016411556364834073454971407636882729626651342464624332583445931037716279976454941621295291266608179784300381978775455761063199246771331988090510227282881824758312010616" ;;

(** 
renyi_string_41
*)

let renyi_string_41 = "0.74759792025341143517873094363652421026172" ;;

(** 
pi_power_e_string_2000
*)

let pi_power_e_string_2000 = "22.459157718361045473427152204543735027589315133996692249203002554066926040399117912318519752727143031531450073148896372716654162727200036841245878483825780197399927516270911185238671352940834892162337692496730536751662599601668725547775888060873742920118171661161372246197209044896331314599273279140914840576764889753784885344102006492593490357594763469165286294007847395407755298019829026131224029511379990688652442931146335939285716073329541491532530137722767555183068793043622842319088286797578297967264718164000704357181058364260641458021223969069744749885161613318405106216364559561084133094289928312637557836158743046929164246018335319342336420036127263824523624703549571835049073419630023545342564129097921194303116908001292522770494403698852612861911839515968731591698101911513070221704547646617959225224684510983208759621594421483998747447264175934025693668265035580476642374237061708505644664324457496738884193688683115925200555602645705059320117009362760553595826641201998120042761370192174862031910519905506816571425870811340528853808629975276085614460926314249761823361686869406515266685962413229106796479209792454561359400328316215872353548736449613197898651307023062935703537082846360598423157484945238146522934841939651220934032766631221216839837299037626473546428923658982018887142263051892244637286989688952629932221082170328499564646586884098400854477924636623980341662609379906902596890092791699406503118363879200217974924860319354120458999797010669295391213233516672591218324888062076891463762345298253525351404898329971337436517350003961883125449684954203283005442012232052307716980668470945979870907851778445856606483290848480861820758755919609039050305827913278716879189191452266911950355455869776770198226974316621958022717872653726612167154548315173292985803868104995405043526449458038171403377697461873928491691112281324245397651802020663132788881315151831992999654261917159535830028527474699812892854833574079721772874399120441167663005232606009645213664966955702763587607" ;;

(** 
pi_square_string_10000
*)

let pi_square_string_10000 = "9.869604401089358618834490999876151135313699407240790626413349376220044822419205243001773403718552231824025913774023144077772348122030046727610617677985197660990399856206575630571506041232840328780869352769342164939666571519044538735261779413820258260581693412515592048309818873270033076266671104358950871504100325788536595276357752837922683318745086404546354125026973729566958334227858150006365227095472490859756072669264752779005285336452206669808264158968771057327889291746901545510069254432457036449656172537928607606008145972589229232414240044295981361814413706777778194739658303170856632789570753407991714523158926372114463828264432852803792850348095233899503968574609485346009017742932205799035917357820465758041931686823002196146899270420614296963466005799840351642136543049984533721736557240463676848876261512299027059938010299446886181716260980130876530037060158369198676286005079936468322669731568367175558971198752975296394916315539449195483877068721130789866575590986536365630763630880611500835373918261101780887902493377295578216579415247442933804078677407591709391197967430171019701193399478202255147637022916080235635868915694957981035172515115828638729327749200473846230329416194494495048211227444683572581318568625916494353763920024500315482187204189247643443645633734136487845294512759163720074302613651868211713304608977784857244325642633307236504523167231561605177369214849850907124480836725107961988402124892451401396531476344595771764744875906954630437531735306768143584751568850946842965505094131196609976199392859352877061669068096915802055359778185132406669086177005221748409135110248458826330653190744031980200668972860975418524501623204699029430643716713312824652744145512848219774751944252293675487441535311800118139325433463830772286708475842537896601572013709965476790662128017400975699856704443725055207780496563411708142905142943795677474924752149438242723251180287627980562139326310912787256163536094247845294787175425161526519133028340747302826358742433797381085687686394930099255723720490122698076952839750216812862138570811782417910988340139751813204641188455558481130020649681920103057369866441623187052150255164484501643442582292115099522112267682316985947707088076002835421495127026066787989083170525169803714975503207554673935379066499127528627090435134345771650747316821081601176280494845157659463594175881261452049538945656523690149904034158136949543437099461111477011418033705087501429944601133969410999684285834770364345758834928601231225087220273175751419933473362658388922974849585619388883423954415166750221884123092283493153150377543332387276400473967671907916524882411512190035978197605342369417152590635189326325811036575715498731696579042267149782182128453116108096076002366401182706029429064598683770691049266596770972660663401548757820706384461878305752277479854412484826969160001428803019711478693597344788599741563981420168466818188245382814284551527166563433815461348826964612563401058424233180650488811945998065171467847020107745117277944162020315035637852927258377267062562705280072611694658628454115675492792240738217874389963994415929853834924324026482187944059760353552904696785049482047062498418996392151877537181463217924411189732335283988604825846749626069626284848011774145342814933313556415342605019366539211238405170306810682148425091403542886543400106732072250355239025432551637745670294713817007541233114058405590453105423509164770143749515764115646910411689551922199259124412506353794915743447718797607298503989299560726218257815149601154690994957878954515651109563949919456804847776960146116980915092419924190652202533970185704132006070922867657069381824946432719104145612087539418417277241439211026780112845600312390563431291680233446108259681761085047218598470247120030997167119294062313927092169603593028026954967153934726568438633869599464524099447180469850807969577725952167728212019226986178765381201089717187602896834366802514251922306048994624344395482550392800312206181752088200939214231089462151221142380748057529627621709580065957213615992288481309543355800840912547247613229088120539701502409180324515414801613253454172548571379673956858490367476442953599331130047363597666621608438117167562827048813989331540086932356462713340693074341619995576025091771164559995655107979112438979005015438350835350340901265375749745944202501561453612406851193223793072222439012130623546214933153525080674235949869002777468310824713671390086261683883202591380429247952542418503859873793567563204791158006144632710694565349643400462929604156570341092115018038871309015148148445625786029843376851154528924551238142190864763622635781966126001325671783290403550121242918881022344330614479083104743732217416853340567174950151232234685749118720996178671384492269109632562172283465603281153577183325350587266265301147732042003251094803695884121879153813986857144116336266004201963450856351970443321250257711052258555155858782570153732632795369400176014039252266619049607180802274163184330699021464906027452039767504013556319455527877556594434840481031171749333597620689443412300858271691893718858215076169873585480158460575758812268659359127060397978268725667503414189886274985966130902678105259900735628763665183315039575781486313060692967604225131015929730168541089362191579438504346009903172589464237995190007119360096070018904752776713072385587558759498043553714093155831489114416875297965992460526866428647633182925884899219410093237281270126910313219232253357977711818415469042222602548566224264259490158702072935092849518137369570923764704432594679426923152519168459455156899033779754083035836101640994080548216159559429867382270493320414353595790109002022212900367796769989636404329398092691335833698932971891674307766779768041037773071500310537819307955603122637174193159534957693259816217627074764094745583321835990526118449128419429667969059636298371826988077667801153091809814621754309154335201742795230683451744481342321762355588582527042689863415120325233190881979557946033919604301799108674600586109686649300093433262419139283264392225553049920535419131323584530081866947802980612639220253027243105822424486070916597216131382027816958075310151008573864217331314200774683622213231067703016805202532295784760086337542454019307711683916955646922061633621686797285774920861758279081492065790230552793811196366667185788625595494627828607515475304126278174327961367499113436260864479177769930431224298006447345989658046772415996358674872284421304090751766877055192427352622198309829264117581813769377376440067441177673919694634538639833503101871227394555068196858892459492640207369411611793113522856941513554236850811154229868454766917180669329212306908608954498597826375071748566845840771853784181050316869881239237253233593583219206555043774166755681858313621909827409674365639855267171085586141344344772246881052473417033649407904942401069254399638081867849150236178295452476747814359389538180876623071618376684542856524326680629726906263789771769536673205252717593838391265082379437597736507392856458560305010907960115873861486070138243141526769277421865171864706308089571284959980532546858026180868081223586576157614719566590823657659445527636582501346480710062983713653361005925597757771235917189330042622069688205335497943767618484634237948266881667287808288782767249168070642563835999048533674355519589505737729902610502726216835060623074435123714916576141842287647588568738761706674449559605676000293439029972566506933966506365036765953517838886921071579822528923353060286203406979457837562119330196803484493096849459868239604074741980710055770035999078504264593982029413540270663279464052860946390002039356954656409236081737283721939939465872087889605972815160583823867654166951238074356975835870185837737111725988878053695789542180692987819699112326070401274796888850385893588184739943711188357711879733521366351900636335633612550591974091982003751100237890657469595232486355393687192784657620858665917551159447158076508959705121765260355030990486845424955796903781395656359448299749333489729328263341726792651666310997355795940287317143964384389426610175126848792721630639004242466927797446571447678802671203948296217328007004730897424366976463565781763605199750245864881919781365594309523718524370870115092561033641601422497886166908085627547594611360193778305474791298990744275654607078391301188588821015695434366403230381205222092832561232684938127579234076025556178735259633756642796666596813174192991002220835916943568433636893056577894515696947603607176043371267028371737319131972857504461809851083108591741092949136100631630631803719979842691794081826787462425823454669648952267040759657060607475483946120116742781497072346098283154123494142965656512106705660025487878358923756513041078105991178276916705913843043751979196087454192805500586928904929171155660399318912684752312154604452371997101283769508718816020675654722893600576556325015370022462637260173781381851928331132294495897725411727052546771536691423415444547612892348024482068477218943402407217052988233581455726146527685062849283141531503484707674038736831579595005152941119154006919379028227497455474603213666864213798753795457264415514217581439525535174460078950387714852590146383959543759622508399128707635681029426767464459775807082598236591567600886463150141509009022295095613294931517162737334972280378100553010776911674564084436155639763412983319641191084290082416228369998168025886057511476021544164013467823703917036596131087036615646112096250126141742604241538945201162257483225744329582155428634694141189783822364195163262146993795830021820742748197548636700724342471562771563844489009132642683955745728038387798526857628697049775587526757123127357246918525430716209635514403973753925854586470173162334538155370260977460037286622870628647902626732836596735562139070114271528596876544048041399951942332629552874711010488186131393725836871158619913842354200534091794002902960842851452139891950864036419925496333686320324800842289154718064193300680927156343552802731337085777648997119436998193911560403713362015448968386886589931759486282677" ;;

(** 
pisot_vijayaraghavan_min_string_1024
*)

let pisot_vijayaraghavan_min_string_1024 = "1.324717957244746025960908854478097340734404056901733364534015050302827851245547594054699347981787280329910920994742207425108902639045897795594314757096723471754166839038867418751736931584253549908246622354533727350458987990956815062774550980248621301216989415752457454862507562652461036893890483993226995207497596282886855690815070451369610985335257728158603344114192782827376529603299358467423102848324169523900610854333821850839810180895735387047393134396731376764602103165276889396393532594399248310310958395377519426028877409271862033892820161525553218270947061305676123988920463730657196297771688630876153324800111768073116684532277431566289960726638357221036347070983837159802233710213098246849086312969366344392445007154150429000819030670589845339053468872874066195775626167061764288919391230837918311716229603886147635880730631509748376758245927028901319509551556012280038595761540178421517618744215955860996699247114780120823733654139737119129264057962484832322634420095923073636101515091300390033271919208565844628" ;;

(** 
one_over_pi_ch_pi_sqrt_3_over_2_string_2000
*)

let one_over_pi_ch_pi_sqrt_3_over_2_string_2000 = "2.4281897920988703287360414361791463581183629447833904976327499747264447341208683681238055015720590438813806801377705872956847589966936033836187324105300392865808669244394657890892491651371066377104252323673607675147979646688639836904850393739332252145805640347256592540290028830867001979398074213872522790089323154228502236515521885815194297560892363347908641995792622259984250909040378684263470763030768385636842185608142679764460596043796303811421041621275844292057700163007280916980100703596621893466128982343192673735582936526960268252695827969447527973522788556399884636296118681899499078622248798356109363043725581948681540712668089039110046272735513927716078337416320928815428889994397208487845323415270800430803554866401575762091559108205822661443142552172670570426310007280323994887051306540159374175370062983819312615469974069317481395354238438130325673813846292110990298812971632204025757373026637787021404782680466464668362246757474415547510332404401129732859289172057826361202415591341320691414286355066207235839140402947798916145909194748511067491857528988108472600419916917960275893578887621848777804200666414640094066666366659061695962487433212942135659098862138218072682527574354007044692378416377618789192673645148831322767020796403995170593560502621672218884712643146275368343297780459511975061235555673521375875748035778776659777816235811663079155556113809261875545662039223374633395136872880693684118840597415337352831152304828824841286248567801036556995482649553616364949385709861118707654681305841219015174685662159709787730991016345808078455565925980891003288634435743709825026053099020264256367104788436657955995570619349714104886667745264632292843536272232451933428675315001115884283005963548074076280385891472617273743006391427828655498922164766406576688662750419251884672348578621105429233053556502012952422035910770779156223960943510643593924861383856922056804894136302733137543295955164256954576711200844560050492902481435945529529155148304619158429612546849411015726741" ;;

(** 
ramanujan_string_2000
*)

let ramanujan_string_2000 = "262537412640768743.99999999999925007259719818568887935385633733699086270753741037821064791011860731295118134618606450419308388794975386404490572871447719681485232243203911647829148864228272013117831706501045222687801444841770346969463355707681723887681000923706539519386506362757657888558223948114276912100830886651107284710623465811298183012459132836100064982665923651726178830863710786452195528154274665109611001472502097904639381778712575009803657792230643121651131087380599298242335584945612399567699978435964864096003266482443521306491599303270530753256568618388265483309802846696242873884751844436838530734115044469478840059464469131682120592946054542163754891890060150356872862933140063632268146351612163764864131429342351600214180513528287731960179813917884407150662994919093496277396207234135302557578180281180210206340974993923837290330361739816633600322612620886664117180538328558970002735722645233287010649586367726698687384859165698266261741988551156844303327351231032433075727331649536152620482684798306053981003157759802511144595774183596489094220203477196778483082245007019118206108478776225735878584402319091953216420763414005680399431546526673794350216992134747713261128519133178491606658068403489787814431322679410839519360265028960726537291276226938242717551278279653750700784001190019241713358327134701518756952318950577522896149682821650782166855605218622283761511045290704651981350624064015699555055607723527235898359267993820905324184058912744801439474570950647586555194756066347107978366612927647920909687903131865554282732062606593248413261523705890098275370715373630772580812755826920872591581902005039751192726281420515295848284628604840714806749933756897548169897911661250320738399632947197475066080743912282251610298715312153928673289056455168511094510850241868813357753938319988751316257344799941108118740096770682577450950592795177900534229227625135157671393352553508698193649538153388239870759679764768250913442427211537562946093572780028074511889735844312259940735819" ;;

(** 
robbins_string_1024
*)

let robbins_string_1024 = "0.6617071822671762351558311332484135817464001357909536048089442294795846461385976313066524807681071201517097753107594109724786805816437216874533242072298244423276409229206078600086480533266938951526942028215425692085403456100394606163834472771107263924054689743459232206969510457176785303874823891119488713091981047559429531205455891503267539401643933207902944734734790101329001545166600642731445463113650395856252896443964373900626507351434749911653354037637867570595882969927006350097838628974046291584277730695574301878858037164700175446019671213359826238765120655515059533828281442492815931568016481658129911912468681742538796067114408338596203624596875532872069899527520914954376831587198260718365693279918213371856394477597958600314953773023535375916819764320886638761213723743456544539160466691236289725645485547899749367949903678745419808730590390397504642988024373398439812709652327266380577792971871730939167151263258578453937892596947761167957028545312570851202124609101739182422265676598386800760949577826879652854" ;;

(** 
salem_string_1024
*)

let salem_string_1024 = "1.176280818259917506544070338474035050693415806564695259830106347029688376548549962096830115581815394659207181379347681765627142993904690801894802523160077596570546062418875048962325907177334571567548096997559812677289401128791972456983735177677402547018406627860300931538336962607762681991597046834646632323107126561241422300847509827575317881149483168558685352483943243465069411489835604855670999941131248924651646199928894650701513975703312904628596531623403673087035935060381181206190204300924108552383983021499538728761959520567397158867506611293458075757439806512470474122134188106798291251486337803701296891625290465195911765657939458514754860892416697489181607020418800779527382130329176339909818744646931915542209759675861811791455556642983564965565963860450434719067256426322958012208664666341022433004123110637753690615489280426703078222637302770682587714578677367444532900397553752134439695945298280306674326082073171899434532475289250584159739440408254461851691378006656323698981137666295496727278749361016763363" ;;

(** 
sin_1_string_1024
*)

let sin_1_string_1024 = "0.8414709848078965066525023216302989996225630607983710656727517099919104043912396689486397435430526958543490379079206742932591189209918988811934103277292124094807919558267666069999077640119784087827325663474848028702986561570179624553948935729246701270864862810533820305613772182038684496677616742662390133827533979567642555654779639897648243286902756964291206300583036515230312782552898532648513981934521359709559620621721148144417810576010756741366480550089167266058041400780623930703718779562612888046360817345246563914202524041877634207492069520077133478098142790214526825566320823352154416091644209058929870224733844604489723713979912740819247250488554873119310350681908151532607457392911183319628215089734868811421452838229865125701667384074455192375614322129060592482739703681801585630905432667846431075312638121732567019856011068360289018950194215161665519179145172004668659597169107219780588540646001994013701405309580855205280525317113323054616383636018169947971500485150793983830395678167948161221402208916987109743" ;;

(** 
quartic_root_of_2_string_1024
*)

let quartic_root_of_2_string_1024 = "1.189207115002721066717499970560475915292972092463817413019002224719466668226917159870781344538137673716037394774769213186063726361789847756785360862538017775070151511403557092273162342868889924175446071908710503849972559105009837104492015484573567458090483994093090003497795908038489658843005041198717009379079820984625235373981281740818113780828552014842210060958932412445931035057519196302941383263474280279824408022800821729272058615366639370400238207308545653067447714859888733457627186783811654704587276127111269988678434930175861424970170054131455143891998743766762178516178317798730704823631873473484218053715698684263648276105622847799586289633293928168787475865603473791996459400756154443715741890303986971294306248625351734129153597531121544674615908647760651744595705593097911946575639891768697217026249747533362991860653115708349368076980494817060743768474678558652825501418464979248909951563378299859508764353239662147789654791045418693466186139614521856391702634160435422985610854932687086815171745404554548532" ;;

(** 
half_sqrt_3_string_5000
*)

let half_sqrt_3_string_5000 = "0.86602540378443864676372317075293618347140262690519031402790348972596650845440001854057309337862428783781307070770335151498497254749947623940582775604718682426404661595115279103398741005054233746163250765617163345166144332533612733446091898561352356583018393079400952499326868992969473382517375328802537830917406480305047380109359516254157291476197991649889491225414435723191645867361208199229392769883397903190917683305542158689044718915805104415276245083501176035557214434799547818289854358424903644974664824214151039320430199436934876879115865891569799649150391935143852695668478165605185363200962455338411559964418782057071100837137605118649713541552994922973799383214444889807391897919511442742645178801692640403219098617233052984486143643263207691133234921001059774207763922059064326725351759582500834464720774042303563857199988146341731478871918094755506357431937348827299122589427548768950694033248095598111147855527762146186159609886913128081573442101642685834146932480595852486941819774796907287883592668681656295544982771231241739359880261799888459616178511015265142019295770748553621477960335310125476008798159293638317998764183171554007533292685532366426931296113029111025520184013514875239936403973082905020852634097000954786673108797194683512466021134551718490623186005559263054213445514986015560105003175358818729120260192377759863996689880745305394749277211166300200942565181578057244342364079464408162259363253332269243879958128832143605562042103400838175855005147159035775759548082123045351970406460845175874648068200206983521552062681616351546128866398014618829887276854773455787107021211539099616380870095321225622743875843134805266684710810680269730212282707006426650390681672492836820335198867111490598052146276725080070297023977357726727420363586882813118327458332011650300663287203505391842923422615658023387724025020112031995598518110930146011943357535550858470014843437983175002044765810711671261397841703350673509295101418035838107387174672478179790404106522129323473426130545413167650437830630173033609770202799206445648799740500038602872011502383662940004575718574473772243957859564732954178543698075776889882013103418542402303648469135979284487987981305207957632878889539116749028392001145076602606946768688776828321352341343714498172069787183303687222279154323894660649265107409869767073908525830747627588164599684978287226131955625954677069349468340871546911321236846310103649548391557706597324218895772995796196414385734757463701320460682282702082229074510097287470965263450130698632304053253571980160303875529709389914239699309762498208260656985764679971094870832353759361789431473305428008521443480289919702645320371540591669433894078131793357800419838012267461497196943352987715772147171547862923549410773155563038338703393228578903032372374987517727227965664327459492466828637381314870736911784345741891568168064181395191242008190333580358992436427792146567461304662028297877682556837732219391714165673332227709019541094949164731317250808556100846480973008466031051651987243311582800178339090672155044828435337148282908872278634250781579720625368059903173644323312066359683471335647572519875946415674309642065162759421558450733571189718736416717232624102189802986643530813745547079843131265127944488423520875100157013114234552402349201621895330336887481355125635530103043133142183302509644544691916000304561434594091842118084695176156346518430689840576347349894596331764219496350825991275112646178968314081728405445653705633918909972488638272414746021940065089177324960678701639578875389300114821175213799849881345936920742369738692578177604561048165791951728359470764717852032653804264508712488409275144263817247478872455521125122686157803180905175243587957901639589918375503356805003310878302478688338855646264365123996336007949820946888100805705914494984147795125582819571118249753142501534840648675362586395929915055763877114942594265588179739300156153186304918492515415542607279787417977785786967831684043241053939562352551581578479080217437441480744707729267778098749964843897754964276371179512590516188343080479627627215997745371033986957853630712266447521404867551898386833006795876131353061615629472534881740658887722803330178811024150345211269474743386476066285988462296383533038290827914933752828644732943045951482219064252892987971875320122303106072804280427262462568416437742171936686010084615581521635282403006879396842836076754390842203901164603231158190564588614887636276553758069184106730228889992731281104098031581800960316548425810811583034173443155831075066192714369565224756157760818281064759373776548828531997751494021282367027889259567476651994432153571589252600399312123424069148817040108814852822860658109915341468231434111113996190820817658629913660653985709633814345784059091998325755015350541335156433200795915635980201946177034129575229788245918427630740173255464494827998091485820424906785146136481107013187529775997375080905292723700988248579688317119428485099110702270510482145419412443049360943824740041797224596723946566554038885" ;;

(** 
sum_inv_binom_2n_n_string_1024
*)

let sum_inv_binom_2n_n_string_1024 = "0.7363998587187150779097951683649234960631258329094979056821966523084718180280786408186944418249022597458272032180147834601769005542298684777329448958806804159151429793343941639989097380834254081520029546146727664979554751571056972458855740951911198864857982943332858183486148704579064932468058211972940741711619867460165444854798895431427869742927249285985327473801566591305125452367494154597773449101860414448973793322220865507304585980050655111918933801733189032706818595729393779635256929202141436280598160887630916476567640892005636816904176527926521540916821972505523264477646813159383043809989583900078755611335395490521438524130346215345759985479021180242189853342592703815843657856790178866385190995898476495781464550452126640744368250524085879359954524202919686774100311819740383505356065846433687090253752952485814436801506664224005219035174975843905156824423431079657061167286839175370864381750319983345379171786501787295831321668074575262367855285101696922360975795282761033968077326069723073543573616136752770598" ;;

(** 
sum_inv_n_binom_2n_n_string_1024
*)

let sum_inv_n_binom_2n_n_string_1024 = "0.6045997880780726168646927525473852440946887493642468585232949784627077270421179612280416627373533896187408048270221751902653508313448027165994173438210206238727144690015912459983646071251381122280044319220091497469332127356585458688283611427866798297286974414999287275229223056868597398702087317959411112567429801190248167282198343147141804614390873928977991210702349886957688178551241231896660173652790621673460689983331298260956878970075982667878400702599783549060227893594090669452885393803212154420897241331446374714851461338008455225356264791889782311375232958758284896716470219739074565714984375850118133417003093235782157786195519323018639978218531770363284780013889055723765486785185268299577786493847714743672196825678189961116552375786128819039931786304379530161150467729610575258034098769650530635380629428728721655202259996336007828552762463765857735236635146619485591750930258763056296572625479975018068757679752680943746982502111862893551782927652545383541463692924141550952115989104584610315360424205129155898" ;;

(** 
sum_inv_n_power_n_string_1024
*)

let sum_inv_n_power_n_string_1024 = "1.291285997062663540407282590595600541498619368274522317310002445136944538765234455558817041129429708984995070924815430548410487419284864197579163555947913696496974156878020799729177948273009025649230550720966638128467012053685745978703001277894129288253551770222383375319345749259967779648300849549111066964975501051975742911621097021561669532897689242789005809390814788094036799305589535200633716110465094638606808864998606531021853412479159737305271068682465224677033686046987023420196583143133968738817295689355368517985214206662641654380612245699409663560438852399693813044840101532338556989547899226146597068180753342912289091004995136410358472374167966099403742887228090823947240301242337506966587431476835029834700965969301980712205941547423918884954889204314784037389693592832744937301860181757952468190913559650620576842700890732654713723383484718562324804417342338565270511374482208606983811697064478963155480311086868468078070105703423000095477662829927022264266182213029160934485049255679995121281765081062180734" ;;

(** 
traveling_salesman_constant_string_1000
*)

let traveling_salesman_constant_string_1000 = "0.7147827007912942720189848796210840967313455970944303193964570041154611773833587970677021341309629453356154722755571789543412745705865418678332452521144843542337016073474747215655061502963522025146788553876357573684944014104023242555236470466487906109957051539389585631220846366979348708311011662084438114847816695339723509976082024871612633547246473496593189361524942722331252501078617572390385009428661885677757347203043959360200441656270343628143074346012351787048160565865171068339609665832627565528256493807993044314908768947970223062111033242507147299146674048018500128353616028403191750664849491151400545304941974122768216141711793430198130113711238211043917590088884878562693426574111070834554473199990410810103607929605939489303477603853384097691276505346715133951595229642503473312207933374437605953123317357381263303863978176680581353601242321427700740129903945834300304237646756913108894130859722547482201434273062276674626022472480156659330677754354367566446245619515011589704068286465445" ;;

(** 
tribonacci_string_1000
*)

let tribonacci_string_1000 = "1.839286755214161132551852564653286600424178746097592246778758639404203222081966425738435419428307014141979826859240974164178450746507436943831545820499513796249655539644613666121540277972678118941041211609223282155956071816712182365986652273378537815696989252117395791413228721061878984085254956931145349134985345957617503596522132381424727272241735818770006979055102549044965710742526547722811006598937555636309333052826235753851971994299145300825466397747290058700597448139193167282584883962633297070068723683112783775025055712227515325957894656057068642228391865969829469135623922044319247614706881145172676671274396414621257184334266234039021835249459103322723106151328699703080803630222332499710524310747235423139974438182656560735194035787491176268052453707922111084971080687641005015654147566223500888566594971582183418486871480290125543699348051367916502585305387827666612622431776635820094298550538732599165178773018447238860426222324857820792721049160181783725613203439814302274533997621231" ;;

(** 
twin_primes_string_42
*)

let twin_primes_string_42 = "0.660161815846869573927812110014555778432623" ;;

(** 
varga_string_41
*)

let varga_string_41 = "9.2890254919208189187554494359517450610317" ;;

(** 
one_ninth_string_46
*)

let one_ninth_string_46 = "0.1076539192264845766153234450909471905879765038" ;;

(** 
zeta_of_minus_05_string_256
*)

let zeta_of_minus_05_string_256 = "-0.2078862249773545660173067253970493022262685312876725376101135571061472919322923404875432669407332156431099756141286895656613269146944583119657056232941095310616400178070070413750783207556662487877869206615046914282912338325693716136777293836109459387888090" ;;

(** 
pi_square_over_6_string_10000
*)

let pi_square_over_6_string_10000 = "1.644934066848226436472415166646025189218949901206798437735558229370007470403200873833628900619758705304004318962337190679628724687005007787935102946330866276831733309367762605095251006872140054796811558794890360823277761919840756455876963235636709710096948902085932008051636478878338846044445184059825145250683387631422765879392958806320447219790847734091059020837828954927826389037976358334394204515912081809959345444877458796500880889408701111634710693161461842887981548624483590918344875738742839408276028756321434601001357662098204872069040007382663560302402284462963032456609717195142772131595125567998619087193154395352410638044072142133965475058015872316583994762434914224334836290488700966505986226303410959673655281137167032691149878403435716160577667633306725273689423841664088953622759540077279474812710252049837843323001716574481030286043496688479421672843359728199779381000846656078053778288594727862593161866458829216065819385923241532580646178120188464977762598497756060938460605146768583472562319710183630147983748896215929702763235874573822300679779567931951565199661238361836616865566579700375857939503819346705939311485949159663505862085852638106454887958200078974371721569365749082508035204574113928763553094770986082392293986670750052580364534031541273907274272289022747974215752126527286679050435608644701952217434829630809540720940438884539417420527871926934196228202474975151187413472787517993664733687482075233566088579390765961960790812651159105072921955884461357264125261475157807160917515688532768329366565476558812843611511349485967009226629697522067778181029500870291401522518374743137721775531790671996700111495476829236420750270534116504905107286118885470775457357585474703295791990708715612581240255885300019689887572243971795381118079307089649433595335618327579465110354669566829283309450740620842534630082760568618023817523823965946245820792024906373787208530047937996760356554385152131209360589349041307549131195904193587753188838056791217137726457072299563514281281065821683209287286748353783012825473291702802143689761801963736318498056689958635534106864742593080188336774946986683842894977740270531175358375860747416940573763715352516587018711280386164324617848012667139236915854504344464664847195087528300619162583867925778989229844416521254771181739189057628608457886136846933529380082474192943243932362646876908674923157609420615024984005693022824923906183243518579501903005617514583571657433522328235166614047639128394057626472488100205204181203378862625236655578893776398153829141597603231480570659069194458370314020515380582192191729590555397879400078994611984652754147068585365005996366267557061569525431772531554387635172762619249788616096507044524963697021408852684682679333727733530451004904844099780628448508211099461828776777233591459636784397410313050958712913309068747471161526666904800503285246448932890798099956927330236694744469698040897135714091921194427238969243558137827435427233509737372196775081468657666344195244641170017957519546324027003385839272975487876396211177093784213345435282443104742352612582132040123036312398327332402654975639154054004413697990676626725592150782797508247007843749736499398691979589530243869654068531622055880664767470974458271011604380808001962357557135822218926069223767503227756535206400861717801780358070848567257147757233351122012041725873170905425272957611715785636167923538852343067598408850903918194128357291585960685941151735281591987033209854068751058965819290574619799601216417331549926787703042969191600192448499159646492419275184927324986576134141296160024352830152515403320698442033755661697617355334345153811276178230304157738786517357602014589903069546206906535171130018807600052065093905215280038907684709946960180841203099745041186671832861186549010385654515361600598838004492494525655787761406438978266577420683241196744975134661596287658694621368669871164363127563533514952864600482805727800419041987051008165770724065913758398800052034363625348033489869038514910358536857063458009588271270284930010992868935998714746884923892633473485424541268871514686756616917068196720752569133602208909028758095229945659476415061246073825599888521674560599611103601406352861260471174802331555256681155392743785556782179056936665929337515295194093332609184663185406496500835906391805891723483544229291624324033750260242268734475198870632178703739835355103924369155525587513445705991644833796244718470785611898347710280647200431896738207992090403083976645632261260534131859667690772118449094224940566743821600692761723515352503006478551502524691407604297671640562808525754820758539690365144127270439296994354333554278630548400591686873819813503724055102413180517457288702902808890094529158358538705780958186453499363111897415378184938760362047244267213525596197220891764544377550191288673667208515800615980686979858968997809524019389377667366993908476058661740553541709618508709759192643130428358955438799228233362669006542044436508267863467045693864055116503577484337908673294584002259386575921312926099072473413505195291555599603448240568716809711948648953143035846028312264246693076762626468711443226521176732996378120944583902364981045830994355150446350876650122604793944197219173262630247718843448827934037521835988288361423514893698596573084057668317195431577372999198334519893349345003150792129452178730931259793249673925619015525971914852402812549660998743421144404774605530487647483203235015539546878354485052203205375559662951969735911507037100424761037377376581693117012155848808253022894928487294117405432446571153858753194743242526149838963292347172639350273499013424702693259904977897045082220069058932631684833670368816727966128331606067388233015448555972283155495315279051294463294673506295511916718422969884659267187106195698859922492948876636036271179127349124263886972665087686408188069904944661509939383061971164679611300192181968302436959051525722533623799205113908624080223720293725931430421173781643902520054205531813663259657672319934050299851445766764351614441550015572210403189880544065370925508320089236521887264088346977824633830102106536708837873850970404081011819432869355230337969493012551691834762310702888552366795780603702205177950502800867088715964126681056257075669884618613986159274487010272270281132880962486810293046513582010965038425465635199394444530964770932582437971434585912550687713029054660227916518906043477413196294988405204049667741224331609674462069332726445812047403550681791961146175865404558770366384971544019596968961562896073344573529612319949105756439972250516978537899092511366143148743248773367894901935298852253809490252259039475135192371644742461152863444888202051151434825749766304395845291427807640128642297363508386144980206539542205598930536534425840629027792613643052270318304568279060939975877861847597690224057462041146842078902838941567984157066844875733273013644641525039363049242079457969059898256363479437178603062780757142754054446771621151043964961961589445534208786265639731877513729906266289417898809409760050835151326685978976914345023040523587794879570310861977451051348261880826663422091143004363478013537264429359602453261098470609609907587939430416891080118343830618942226834320932959628539319531555007103678281367555916323961269747439039658044480277881301381463794541528011773760639333174755612392586598250956288317101750454369472510103845739187285819429356973714607931428123126951112408259934279333382239838328761084488994417727506127658919639814486845263303754820558843381033901163242972927019888366133914082182808243311373267345790330118342628339333179750710765663671568923378443879910675476824398333673226159109401539346956213953656656577645347981600995469193430637311275694491873012392829305978364306289518620998146342282631590363448831303283185387678400212466148141730982264697456657285198059618646622253561058650106055938935425098662348663667291850039648442911599205414392565614532130776270143110986258526574526346084826617520294210059171831747807570825966150630232609393241383291555581621554710556954465441944385166225965990047886190660730731571101695854474798786938439834040411154632907761907946467111867324716036221334500788482904061162743927630293934199958374310813653296894265718253953087395145019182093505606933570416314361151347604591265768560032296384245798549831790712609101179731883531431470169282572394400538396867537015472093538780823021263205679337592696455876605626107132777766135529032165167036805986157261405606148842762982419282824600601196007228544504728622886521995476250743634975180518098623515491522683438605105300619996640448632346971131243737637242444941492044506793276176767912580657686686123796916178724349713859020582357160942752017784276670914646393153959418840179684331863046152784318973840625329866014575698800916764488150821528525943399886485447458718692434075395332850213961584786469336779275787148933429426054169228337077106210028963563641988055188715749316287568621175424461922781903902574091268815391337413678079536490567067869508831372263575954357754614177141547190255250580784612339789471929932500858823519859001153229838037916242579100535611144035633125632576210735919036263573254255862410013158397952475431691063993257293270418066521451272613504904461244076629301180433039431927933481077191690251501503715849268882488586193789555828713396350092168462818612427347406025939960568830553273531847381680402704728333028004314342918579336924027335577970617319506099355181172769274352016041687690290434040256490866860376247204290721597025904772449023531630637060699193877024498965971670303457124699591439450120723745260461927307414834855440447325957621339731299754476271449508295931254459520521226207819754238452701605919067328958987642431078362193722423025895043496243339547770478438107983771122139432789260356511685711921432812757341340233325323722104925479118501748031021898954306145193103318973725700089015299000483826807141908689981991810672736654249388947720054133473714859119677365550113487859390592133788556180962941499519906166365651926733952227002574828064481098321959914380446" ;;

(** 
apery_string_2000
*)

let apery_string_2000 = "1.2020569031595942853997381615114499907649862923404988817922715553418382057863130901864558736093352581461991577952607194184919959986732832137763968372079001614539417829493600667191915755222424942439615639096641032911590957809655146512799184051057152559880154371097811020398275325667876035223369849416618110570147157786394997375237852779370309560257018531827900030765471075630488433208697115737423807934450316076253177145354444118311781822497185263570918244899879620350833575617202260339378587032813126780799005417734869115253706562370574409662217129026273207323614922429130405285553723410330775777980642420243048828152100091460265382206962715520208227433500101529480119869011762595167636699817183557523488070371955574234729408359520886166620257285375581307928258648728217370556619689895266201877681062920081779233813587682842641243243148028217367450672069350762689530434593937503296636377575062473323992348288310773390527680200757984356793711505090050273660471140085335034364672248565315181177661810922279191022488396800266606568705190627597387735357444478775379164142738132256957319602018748847471046993365661400806930325618537188600727185359482884788624504185554640857155630071250902713863468937416826654665772926111718246036305660465300475221703265136391058698857884245041340007617472791371842774108750867905018896539635695864308196137299023274934970241622645433923929267278367865571555817773966377191281418224664126866345281105514013167325366841827929537266050341518527048802890268315833479592038755984988617867005963731015727172000114334767351541882552524663262972025386614259375933490112495445188844587988365323760500686216425928461880113716666635035656010025131275200124346538178852251664505673955057386315263765954302814622423017747501167684457149670488034402130730241278731540290425115091994087834862014280140407162144654788748177582604206667340250532107702583018381329938669733199458406232903960570319092726406838808560840747389568335052094151491733048363304771434582553921221820451656004278" ;;

(** 
zeta_of_4_string_10000
*)

let zeta_of_4_string_10000 = "1.082323233711138191516003696541167902774750951918726907682976215444120616186968846556909635941699917232990813908042742414584071574570045349282003514716219207087783480910837029326188734826175273604235506219373750617111745349296867750733076066869341189058628337952795120334495890468862626948220835032983632149020532123955724846646225501156660455882686787653504495435137197495148863132897472588575145532476189232474908834318321655996289964805402049885566090671081314547243825177525046950255251413220769809559647768627752929740036246883363353122775866809833233774020814980714241095754573232796882922763249422259676821487316421013008338304857888029604986778592583597721217132566518880028102763858126993138754552377813713363546265685051029988928702395169208607033961608825916990154658882958945601483845254593115070173827990207156919534095158527358830154287943379374639008403461164637204262702826682436899279230246165111144110268656089906925423491696389063527553029526549029455842027676257024110188678074085579452005253761923369997515928096279957735788156042924622756459643848938707419990237590675060737116163221454757845099503463306529305446421008433041104942882398718277947221071795716201397349750627335491918272653731580142907064411223898446288874934612362178568442209533776566506312339341830933159036648943667135395005210879531662796787012321260651175331738329199435194306370944545870307584187596631588047097620977833191056627837374922267861933693224362921293768021477627698822727516116819567458132699267151476761574399664531856280752263471275668320573267687304369087265526744491073088747143477176881323859052741683061377320740876175345996813167155161002479898821791227843260994055284248985355482228593901720667160284527024334557933935573813974508082557702748525491635492755104926546560269855631533994957889560677833818650014696522323053353466995236997634337967042287649644695675404965250399770607843463192955638287173786004750497702156764291416320835513480579256606825802994619716116662629620687398536533318287723596564502555913625727654396986998826326225254695236018787378236867335482138700423579286159570652976263407615843118885599325979193271352001027402079181175879070747941654748910618360761777367854734911307291628176290889637287720536217985348688017469947010738379593420153538192433293260199574237114944555413764464983387473360091728693905427525896496922137343815968151352736515236816085934744931434807590034524802237124834070989396454115386614211992796583014345970800557564021960121366380652738907873684715582481208503324833678580927746134596524169753045678153911388852182135948609882288497119748841952844639107549506635325226397939625678056802341299436102088253046031536961501061590764038844900287564911195676100489344478826266763689148286879835541286086808388167725869365290400749795516721395908843701427511769412985427005077194002770485536852744247660905896304735553772697535260685748327670406394919847483760158485418345762264368869106825518285261307248028011648363975595616986983932893348575121857515498033506904637636100945572187893548484934413747617194784891704904620935512947961839866080990219059273760162016904089081064650889846038031754372153405416906501244431710513172198630917237853760894068323265609943728858126959004563130362050842426692325047184665928815068133548318430772697019542231747792913244386915941628248164377805458383682801812799515350781160375981744928483626309020122099775663775294427292303905084058852665547854263245619464939792032188608627614895931820412371544257226190506405174882941216700673048924427787122419844992480799791247309799419551950292005284357503525129680523098021745583495025991519012047170373689396916248174172996297067005319244801633164564450133339076904892582562040490314368998591066745523144288739814247402211467667806446571478577607332809006007773480812684005607151861735666810782103523038228094782015339876270448169119140026057615004115741334757674287964191558482978462764525057591848290805400443710962817912488728406532641105462738487502266654489857409149420128070924808433589106134729017651136402451344142390090289737208850294929358436592475430009082709308862189010336974327733676906458892303477342154653554440759443432989814172298563395428205251016452623391371966157008558224723939254490888830009176949417979367683457999897449124161346936207982631669885420989082030821123448801199798752709606231665588447867834556290766121219992338311829235052921118966491227399531967668370142794831047589757715383922800355765450576613999356262590157353384467201628786098367344565956390928968502519105926227670158361166555710604061039009465643832090309918797050737988145232725887818983338320452524003716590543807639953811382838845395577758051549421449267066908212745713097428348598309291408872649211849743226637122682487594838961498171685675237850160684532435940477615149897794476328808749018943156798087198446757734568512821191068943686193197346744297790019168610570996070424713964002491876686167195561858191747330917875376573521238560729822710648010653714972209325443628342184747457628217972531552003901106787631740674948674763934798289676618333757689620286040107155298937101600830906019099241280908861444164665410589350576240738744092379592767867731405470898520852061143553540801665422906728543068255446971760758123108060415696790390176190811293687656074889634192029437071321676779338863876193028008542506046190622247360414535168798576090321564303499683576618113199774653159718769971761056452795265288209388411599157745169854994262967809399347272635430993919035794264572096854310743119746880998062743757086214429571092461657680227687407574422143238087674825015547060574228137828790264082254263491908079870499077668013002078887823954090162669576222020593742671351669011674888918277634822804054630064116478740440684600041077925765456606619934129932716894683445681788777692182944271694653243287245140306127289130986436506698048938350991628602240961391007756852610900980380169756322541088195045951022800293335048902316417365066287069143410664894876123736468655649226783894487741562355481599254923052265360446680276207412464851803163158020855677102318737829734077646356357383308217533363025828879319015578264005846874965245799615012953041875830516137633918470867828085857735093778560537953406549855149786697241211433934054712330915609923522315897659954386864655428311689605553302658888442417320625548905810834507619197511185383493621162383884558684632435587132319835471204283414928593976509237969010799696002917402310749055219115603458002357726631378611186202743901845557884019376192574360408479153537263536167123370576523128559962187896777392919578014133750238232858604144920585392613869951145813788892578606455130586337807268621616495207109295223151200198081989183065137189409852172549910159317629411731675857609358328498150493628814797414379755024565741153909981733901317621579422615481816127741592685491329957520106187664286212179780678098362831568213136586837737482885012996520371296205679582559970964698130489253050372812719180815167213266054673081320152717775936539735604851682889477052847181775800900633890322158201779282947402992365201977899373891492111747003949088276109548177232051844562715066536686278324499990405401772957239073253860743218148993303985152894366964377352897633247417160863094109085959736311478318831223977860999297251759633778898511208462334950828084328120042805860771881141462197296550479476610197852968159604844147572886950854056731676811434888913896152030078893464230925959871527303378329153446574689473744953207959930361826636803132423077405389244362308621837822812643995896842444589720036145936446362317253257259666118389502763835342344438964311439111533438864590294144950073257176315116262816464982997336465180299779318928795002268110536037219483953301617640385848455456410850706513312148034510532443809904031819095584919749706190474552632850925592856032479898850845200825465945858075196557407957566417215142928345753033443383224733920555034008193427140787552358823903892868823103111668577407090235339940622055393535335970599158529439606563583220529649027471995495454563557110482760834229344985104320601042576959601754851302975104666945772991100277122462585076419285125648603976077754503179786382980543062545424219719265084554917910295762451408285567890332884034432500107532577119044190352467910291663592765368251036585046620837055755826083050584847544449094205551702551406123629551721712685790300377131283577635669315023713479786663395385817457471064913657995323245548710712484192394571005528148128117202656046806040969381816139212059331060081617961550155831189855027094848266926254740258621026488660322442344423978717735494616461617099731844694558711229893770138174279406480031716843684942174482050343381467042801772439534570367111916711758572894306560416319054783953326444311812174062853072015734440609046391563145172426783192830883411923973624838329247117828247062451806390017992103022878201513899673476629535137467555467362200232354292007898361153209968412174918622566506396524076912974010254078526055969488534637332563278032249992818765755073304422265764802989158304297647351195058585547770535778461419119798618680334990905039905168427744716846264582730961305803852432477984403810648328440535226978314327906144232822544342686326764696631316136159743428604107950987067582065290664320544681207816508719860841045235196649771534100021389622663954223789866420316855964681964432884884184527036778591507449414582611742131883471289145656589195749238228218990336659240697281002835356619888512880299788599508197592228798094386450892687559785317826185410291142773703449952070620881411327300425521732479940267646499011627990155929360297475160632506592237968795295485354201571466476168627984254774546399239155807686116033924699676012988333828307953892243643862298334611890762062067208705350362412978426042661677850971954531283336709977891181953260122879490792096761409290441844687617233417209694968811621205450984129489709725292403372983366700604396730817236302039406307852144889482341846689797435601688050407630063936341762674388635891" ;;

(** 
zeta_of_5_string_512
*)

let zeta_of_5_string_512 = "1.0369277551433699263313654864570341680570809195019128119741926779038035897862814845600431065571333363796203414665566090428009617791559708418351107218008764486628633718035359836396236512888898133527677523982750320224368457664446659581159939179777450392446439196666159664016205325205021519226713512567859748692860197447984320067268129753091990077465655860152657373003756153268314989797193503983785813199228848864253351042516025108499043464029411724327576341508162332245618649927144272264614113007580868316916497918" ;;

(** 
zeta_of_7_string_512
*)

let zeta_of_7_string_512 = "1.0083492773819228268397975498497967595998635605652387064172831365716014783173557353460969689138513239689614536514910748872867774198403354403157983010339845621210694635852439065833539646769975676966914278043143339474952153789028002590455519793531083700842107329399046107085641235605890622599776098694754076320000481632951258676925063073441363255560136030500737330241318703795102662477939546502254670420155104055822242392505108688377270774260021771000195455778989836046745406121952650765461161356548679150080858554" ;;

(** 
zeta_of_9_string_512
*)

let zeta_of_9_string_512 = "1.0020083928260822144178527692324120604856058513948887565485966159097850533902583989503930691271695861574086047658470602614253739707224301530691324987642510909294868767654539697941540782602296415448362506686290567073645216015314244213263375988155580525914540848901539527747456133451028740613274660692763390016294270864220112316220924126575332620546229321545466517994503866277822356477616603302814923645703993011193839850171679260020649230697958509458457966548540026945118759481561430375776154443343398399851419383" ;;




(**
§
*)

(**

Conversions au format Num.num

Conversions into the format Num.num

 *)

(**
*)





(** In accordance with the following result, a mantissa of 1024 bits corresponds to 308 decimal digits.

# 1024. *. ( log 2. ) /. ( log 10. ) ;;

- : float = 308.25471555991669

En vertu du résultat précédent, une mantisse de 1024 bits correspond à 308 chiffres décimaux. *)



(** 
num_e_1024
*)

let num_e_1024 = Num.num_of_string ( "2" ^ ( String.sub e_string_1000 2 320 ) ^ " / 1" ^ ( String.make 320 '0' ) ) ;;

(** 
num_log_2_1024
*)

let num_log_2_1024 = Num.num_of_string ( ( String.sub log_2_string_1000 2 320 ) ^ " / 1" ^ ( String.make 320 '0' ) ) ;;

(** 
num_log_10_1024
*)

let num_log_10_1024 = Num.num_of_string ( "2" ^ ( String.sub log_10_string_2000 2 320 ) ^ " / 1" ^ ( String.make 320 '0' ) ) ;;




end ;;




(**
§ § §
*)





end ;;


module Hash = struct



open Util ;;
open Bary ;;
open Data ;;



module type Hash_type = sig

type t
val high:int
val low:int
val hash:t -> int

end ;;



module Z = struct

type t = int ;;

(** 
high
In case of equirepartition, the depth of the binary trees does not exceed four.

En cas d'équirépartition, la profondeur des arbres binaires équilibrés ne va pas au-delà de quatre. *)


let high = 32 ;;
let low = 32 ;;
let hash = fun x -> Hashtbl.hash x ;;

end ;;



module Big = struct

type t = Big_int.big_int ;;

(** 
high
In case of equirepartition, the depth of the binary trees does not exceed four.

En cas d'équirépartition, la profondeur des arbres binaires équilibrés ne va pas au-delà de quatre. *)


let high = 32 ;;
let low = 2 ;;
let hash = fun x -> Hashtbl.hash x ;;

end ;;



module Number = struct

type t = Num.num ;;

(** 
high
In case of equirepartition, the depth of the binary trees does not exceed four.

En cas d'équirépartition, la profondeur des arbres binaires équilibrés ne va pas au-delà de quatre. *)


let high = 32 ;;
let low = 2 ;;
let hash = fun x -> Hashtbl.hash x ;;

end ;;



module Multi_hasher (Index:Bary.Index_type) (Hasher:Hash_type with type t = Index.t) = struct

type t = Index.t array ;;
let high = Hasher.high ;;
let low = Hasher.low ;;
let multi_hash = Array.map Hasher.hash ;;

(** A null hash value must be avoided when it is considered as a coefficient in a sparse vector.

Il faut éviter une valeur de hachage nulle quand elle est considérée comme coefficient dans un vecteur creux. *)


let hash = function (x:t) ->
 begin
 let y = Hashtbl.hash ( multi_hash x ) in
  if y = 0 then
   max_int
  else
   y
 end ;;

end ;;



module Make (Index:Bary.Index_type) (Hasher:Hash_type with type t = Index.t) (Weight:Bary.Weight_type) = struct




(**
§
*)

(**

Introduction

 *)

(**
*)





(** The mathematician will find in this module tools to treat couples (index, weight) in hash tables.

If the index is an integer and the weight an element of a ring or a field, sparse vectors may be treated.

If the index is an element of a totally ordered set and the weight an integer, then (totally ordered) sets may be treated with multiplicity.

Conventions

The hash tables are arrays of weighted sets.

The functions of this module are not sealed.

Comments

This module is inspired by the module Hashtbl of the standard library of OCaml.

This module is distributed under the same licence as Ocaml.

§

La mathématicienne ou le mathématicien trouvera dans ce module des outils pour traiter des couples (indice, poids) dans des tables de hachage.

Si l'indice est un entier et le poids un élément d'un anneau ou d'un corps, on peut traiter des vecteurs creux.

Si l'indice est un élément d'un ensemble totalement ordonnné et le poids un entier, on peut traiter des ensembles (totalement ordonnnés) avec multiplicité.

Conventions

Les tables de hachage sont des tableaux d'ensembles à poids.

Les fonctions de ce module ne sont pas étanches.

Commentaires

Ce module est inspiré du module Hashtbl de la bibliothèque standard d'OCaml.

Ce module est distribué selon la même licence qu'Ocaml.

Copyright Stéphane Grognet
Laboratoire de mathématiques Jean Leray UMR 6629 CNRS
Fédération de recherche mathématique des Pays de la Loire
Centre Henri Lebesgue
IREM des Pays de la Loire - Université de Nantes
version 0.1
*)

(** @version 0.1 *)

(** @author Stéphane Grognet *)

(** @since 2013 *)





(**
§
*)

(**

Ensembles à poids

Weighted sets

 *)

(**
*)





(** The type elt consists in couples (index, weight) and is identified with the type elt of the following module B.

Le type elt est formé par couple (indice, poids) et est identifié avec le type elt du module B suivant. *)



type index = Index.t ;;

type weight = Weight.t ;;

type elt = index * weight ;;


(** The module B provides the weighted sets.

Le module B fournit les ensembles à poids. *)



module B = ( Bary.Make (Index) (Weight)
: sig
 include module type of Bary.Make (Index) (Weight)
end
 with type elt := elt with type index = index with type weight = weight ) ;;


(** 
element_copy element
*)

let element_copy = function (x:elt) ->
 B.element_copy x ;;

(** 
set_copy element
*)

let set_copy = function (s:B.t) ->
 B.copy s ;;




(**

Tables de hachage

Hash tables

 *)

(**
*)





(** The type t records the hash table together with its filling value. A switch shows if the length of the array must be automatically tuned in some operations.

Le type t enregistre la table de hachage avec la valeur de son remplissage. Un commutateur indique si la longueur du tableau doit être ajustée automatiquement dans certaines opérations. *)


type t =
 { mutable filling: int ; mutable auto: bool ; mutable data: B.t array } ;;


(** 
create initial_size
A negative initial size activates the switch of the automatic tuning of the length.

Une taille initiale négative active le commutateur d'ajustage automatique de la longueur. *)


let create = function (initial_size:int) ->
 let s = min ( max 1 ( abs initial_size ) ) Sys.max_array_length in
  let table = Array.map B.empty ( Array.make s () ) in
   for i = 0 to pred s do
    table.(i) <- B.empty () ;
   done ;
   if initial_size < 0 then
    { filling = 0 ; auto = true ; data = table }
   else
    { filling = 0 ; auto = false ; data = table }


(** 
make element initial_size
A negative initial size activates the switch of the automatic tuning of the length.

Une taille initiale négative active le commutateur d'ajustage automatique de la longueur. *)


let make = fun (x:elt) (initial_size:int) ->
 let s = min ( max 1 ( abs initial_size ) ) Sys.max_array_length in
  let table = Array.map B.empty ( Array.make s () ) in
   for i = 0 to pred s do
    table.(i) <- B.singleton x ;
   done ;
   if initial_size < 0 then
    { filling = s ; auto = true ; data = table }
   else
    { filling = s ; auto = false ; data = table }

(** 
clear table
*)

let clear = function (h:t) ->
 let r = Array.length h.data in
  for i = 0 to pred r do
   h.data.(i) <- B.empty () ;
  done ;
  h.filling <- 0 ;;

(** 
copy table
*)

let copy = function (h:t) ->
 let r = Array.length h.data in
  let out = create r in
   for i = 0 to pred r do
    out.data.(i) <- set_copy h.data.(i) ;
   done ;
   out.filling <- h.filling ;
   out ;;

(** 
filling table
*)

let filling = function (h:t) ->
 h.filling ;;

(** 
length table
*)

let length = function (h:t) ->
 Array.length h.data ;;

(** 
size table
*)

let size = function (h:t) ->
 if h.auto then
  - ( Array.length h.data )
 else
  Array.length h.data ;;

(** 
expand table
*)

let expand = function (h:t) ->
 let r = Array.length h.data in
  let new_length = min ( 2 * r ) Sys.max_array_length in
   let table = Array.map B.empty ( Array.make new_length () ) in
    let f = function ((key,load) as x:elt) -> B.add x ( table.( ( Hasher.hash key ) mod new_length ) ) in
     for i = 0 to pred r do
      B.E.iter f h.data.(i).B.content ;
     done ;
     h.data <- table ;;

(** 
retract table
*)

let retract = function (h:t) ->
 let r = Array.length h.data in
  let new_length = max 1 ( r / 2 ) in
   let table = Array.map B.empty ( Array.make new_length () ) in
    let f = function ((key,load) as x:elt) -> B.add x ( table.( ( Hasher.hash key ) mod new_length ) ) in
     for i = 0 to pred r do
      B.E.iter f h.data.(i).B.content ;
     done ;
     h.data <- table ;;

(** 
resize new_length table
*)

let resize = fun (new_length:int) (h:t) ->
 let nl = abs new_length in
  let table = Array.map B.empty ( Array.make nl () ) in
   let f = function ((key,load) as x:elt) -> B.add x ( table.( ( Hasher.hash key ) mod nl ) ) in
    for i = 0 to pred ( Array.length h.data ) do
     B.E.iter f h.data.(i).B.content ;
    done ;
    if new_length < 0 then
     h.auto <- true
    else
     h.auto <- false ;
    h.data <- table ;;


(** 
auto_resize table
If the filling exceeds Hasher.high times the length of the table, then the size is doubled. If the size exceeds Hasher.low times the filling, then the size is divided by two.

Si le remplissage dépasse Hasher.high fois la taille de la table, la taille est doublée. Si la taille dépasse Hasher.low fois le remplissage, la taille est divisée par deux. *)


let auto_resize = fun (h:t) ->
 let r = Array.length h.data in
  if h.filling > Hasher.high * r then
   resize ( 2 * r ) h
  else if r > Hasher.low * h.filling then
   resize ( max 1 ( r / 2 ) ) h ;;

(** 
elements table
*)

let elements = function (h:t) ->
 let f = function s -> snd ( B.elements s ) in
  let t = Array.map f h.data in
   List.concat ( Array.to_list t ) ;;

(** 
apply table function element
*)

let apply = fun (h:t) (f:elt -> B.t -> unit) ((key,load) as x:elt) ->
 if not ( Weight.eq_zero load ) then
  begin
   let i = Hasher.hash key mod (Array.length h.data) in
    let previous = B.cardinal h.data.(i) in
     f x h.data.(i) ;
     h.filling <- h.filling + ( B.cardinal h.data.(i) ) - previous
  end ;
 if h.auto then
  auto_resize h ;;

(** 
add table element
*)

let add = fun (h:t) (x:elt) ->
 apply h B.add x ;;

(** 
sub table element
*)

let sub = fun (h:t) (x:elt) ->
 apply h B.sub x ;;

(** 
raw_apply table function element
*)

let raw_apply = fun (h:t) (f:elt -> B.t -> unit) ((key,load) as x:elt) ->
 let i = Hasher.hash key mod (Array.length h.data) in
  let previous = B.cardinal h.data.(i) in
   f x h.data.(i) ;
   h.filling <- h.filling + ( B.cardinal h.data.(i) ) - previous ;
   if h.auto then
    auto_resize h ;;

(** 
remove table element
*)

let remove = fun (h:t) ((key,load) as x:elt) ->
 raw_apply h B.remove x ;;

(** 
index_mem table key
*)

let index_mem = fun (h:t) (key:index) ->
 let i = Hasher.hash key mod (Array.length h.data) in
  B.E.mem ( key , Weight.zero () ) h.data.(i).B.content ;;

(** 
index_find_all table key
*)

let index_find_all = fun (h:t) (key:index) ->
 let i = Hasher.hash key mod (Array.length h.data)
 and p = function z -> Index.compare key ( fst z ) = 0 in
  let ( with_key , without_key ) = B.E.partition p h.data.(i).B.content in
   ( i , with_key ) ;;

(** 
index_find table key
*)

let index_find = fun (h:t) (key:index) ->
 let ( i , with_key ) = index_find_all h key in
  try
   B.E.choose with_key
  with _ ->
   ( key , Weight.zero () ) ;;

(** 
load_find_all table load
*)

let load_find_all = fun (h:t) (load:weight) ->
 let p = function z -> Weight.compare load ( snd z ) = 0
 and accu = ref B.E.empty in
  for i = 0 to pred ( Array.length h.data ) do
   let ( with_load , without_load ) = B.E.partition p h.data.(i).B.content in
    accu := B.E.union with_load !accu ;
  done ;
  !accu ;;

(** 
load_find table load
*)

let load_find = fun (h:t) (load:weight) ->
 try
  B.E.choose ( load_find_all h load )
 with _ ->
  failwith "Not found in Hash.Make.load_find." ;;

(** 
element_mem table key
*)

let element_mem = fun (h:t) ((key,load) as x:elt) ->
 let i = Hasher.hash key mod (Array.length h.data) in
  B.strong_mem x h.data.(i) ;;

(** 
element_find_all
*)

let element_find_all = fun (h:t) ((key,load):elt) ->
 let i = Hasher.hash key mod (Array.length h.data)
 and p = fun ( y , z ) -> ( Index.compare key y = 0 ) && ( Weight.compare load z = 0 ) in
  let ( with_pair , without_pair ) = B.E.partition p h.data.(i).B.content in
   ( i , with_pair ) ;;

(** 
element_find
*)

let element_find = fun (h:t) (x:elt) ->
 try
  B.E.choose ( snd ( element_find_all h x ) )
 with _ ->
  ( fst x , Weight.zero () ) ;;

(** 
replace table element
*)

let replace = fun (h:t) ( ( key , load ) as x: elt ) ->
 if Weight.eq_zero load then
  remove h x
 else
  begin
   let i = Hasher.hash key mod (Array.length h.data)
   and p = function z -> Index.compare key ( fst z ) = 0 in
    let ( with_key , without_key ) = B.E.partition p h.data.(i).B.content
    and previous = h.data.(i).B.cardinal in
     h.data.(i).B.content <- B.E.add x without_key ;
     let difference = 1 - ( B.E.cardinal with_key ) in
      h.data.(i).B.cardinal <- previous + difference ;
      h.filling <- h.filling + difference ;
  end ;;

(** 
in_place_map weight_function table
*)

let in_place_map = fun f (h:t) ->
 let r = Array.length h.data
 and ff = function ( i , x ) -> ( i , f x ) in
  for i = 0 to pred r do
   h.data.(i) <- B.map ff h.data.(i) ;
  done ;;

(** 
in_place_mapi function table
*)

let in_place_mapi = fun f (h:t) ->
 let r = Array.length h.data
 and ff = function ( i , x ) -> ( i , f i x ) in
  for i = 0 to pred r do
   h.data.(i) <- B.map ff h.data.(i) ;
  done ;;

(** 
in_place_opp table
*)

let in_place_opp = function (h:t) ->
 let r = Array.length h.data in
  for i = 0 to pred r do
   h.data.(i) <- B.opp h.data.(i) ;
  done ;;

(** 
iter function table
*)

let iter = fun f (h:t) ->
 let r = Array.length h.data
 and accu = ref 0 in
  for i = 0 to pred r do
   B.E.iter f h.data.(i).B.content ;
   let contribution = B.E.cardinal h.data.(i).B.content in
    h.data.(i).B.cardinal <- contribution ;
    accu := !accu + contribution ;
  done ;
  h.filling <- !accu ;
  if h.auto then
   auto_resize h ;;


(** 
copy copy_function table
The copy function is supposed not to change the hash value of the first factor.

La fonction de recopie est censée ne pas changer la valeur de hachage du premier facteur. *)


let copy = fun f (h:t) ->
 let r = Array.length h.data in
  let hh = create r in
   for i = 0 to pred r do
    hh.data.(i) <- B.map f h.data.(i) ;
   done ;
   hh.filling <- h.filling ;
   hh.auto <- h.auto ;
   hh ;;

(** 
map weight_function table
*)

let map = fun (f:weight -> weight) (h:t) ->
 let r = Array.length h.data
 and accu = ref 0
 and ff = function ( a , b ) -> ( a , f b ) in
  let hh = create r in
   for i = 0 to pred r do
    hh.data.(i) <- B.map ff h.data.(i) ;
    accu := !accu + B.cardinal hh.data.(i) ;
   done ;
   hh.filling <- !accu ;
   hh.auto <- h.auto ;
   if hh.auto then
    auto_resize hh ;
   hh ;;

(** 
mapi function table
*)

let mapi = fun f (h:t) ->
 let r = Array.length h.data
 and accu = ref 0
 and ff = function ( a , b ) -> ( a , f a b ) in
  let hh = create r in
   for i = 0 to pred r do
    hh.data.(i) <- B.map ff h.data.(i) ;
    accu := !accu + B.cardinal hh.data.(i) ;
   done ;
   hh.filling <- !accu ;
   hh.auto <- h.auto ;
   if hh.auto then
    auto_resize hh ;
   hh ;;

(** 
opp table
*)

let opp = function (h:t) ->
 let r = Array.length h.data in
  let hh = create r in
   for i = 0 to pred r do
    hh.data.(i) <- B.opp h.data.(i) ;
   done ;
   hh.filling <- h.filling ;
   hh.auto <- h.auto ;
   hh ;;

(** 
fold function table init
*)

let fold = fun (f:elt -> 'a -> 'a) (h:t) (init:'a) ->
 let r = Array.length h.data
 and accu = ref init in
  for i = 0 to pred r do
   accu := B.fold f h.data.(i) !accu ;
  done ;
  !accu ;;

(** 
dump table
*)

let dump = function (h:t) ->
 let r = Array.length h.data
 and cmp = fun x y -> Index.compare ( fst x ) ( fst y )
 and accu = ref [] in
  for i = 0 to pred r do
   accu := List.merge cmp ( B.to_list h.data.(i) ) !accu ;
  done ;
  !accu ;;

(** 
flush table
*)

let flush = function (h:t) ->
 let r = Array.length h.data
 and cmp = fun x y -> Index.compare ( fst x ) ( fst y )
 and accu = ref [] in
  for i = 0 to pred r do
   accu := List.merge cmp ( B.to_list h.data.(i) ) !accu ;
   h.data.(i) <- B.empty () ;
  done ;
  h.filling <- 0 ;
  !accu ;;

(** 
of_list size element_list
*)

let of_list = fun (size:int) (x:elt list) ->
 let h = create size in
  ignore ( List.rev_map ( add h ) x ) ;
  h ;;

(** 
min table
*)

let min = function (h:t) ->
 let accu = ref ( Weight.zero () ) in
  let f = function ( i , x ) ->
   if compare x !accu < 0 then
    accu := x in
   iter f h ;
   !accu ;;

(** 
max table
*)

let max = fun (h:t) ->
 let accu = ref ( Weight.zero () )in
  let f = function ( i , x ) ->
   if compare x !accu > 0 then
    accu := x in
   iter f h ;
   !accu ;;

(** 
extract index table
*)

let extract = fun (i:index) (h:t) ->
 let j = Hasher.hash i mod (Array.length h.data) in
  try
   B.extract i h.data.(j)
  with _ ->
   failwith "Bad index in Hash.Make.extract." ;;
 




(**
§ § §
*)




end ;;


end ;;







module Sparse_vector = struct




(**
§
*)

(**

Introduction

 *)

(**
*)




(** The mathematician will find in this module functors to handle sparse vectors with coefficients in a commutative rng or a field.

Conventions

The indices are polymorphic and must be structured in a module. The indices that immediately come to mind are in the types int, int array, Big_int.big_int, Big_int.big_int array. For the multi-indices, the order may be lexicographic or anything else.

Comments

This module is inspired by the module Hashtbl of the standard library of OCaml.

A function is sealed if there is no sharing between the input variables and the output value. This is the expected behavior of usual mathematical functions. Copy functions are provided. They are sealed provided that they receive as argument elementary copy functions for coefficients and indices. By composition, they permit to seal all functions necessary.

This module is distributed under the same licence as Ocaml.

§

La mathématicienne ou le mathématicien trouvera dans ce module des foncteurs pour traiter les vecteurs creux à coefficients dans un annau commutatif ou bien dans un corps commutatif.

Conventions

Les indices sont polymorphes et doivent être structurés dans un module. Les indices qui viennent immédiatement à l'esprit sont dans les types int, int array, Big_int.big_int, Big_int.big_int array. Pour les multi-indices, l'ordre peut être lexicographique ou autre.

Commentaires

Une fonction est étanche quand il n'y a aucun partage entre les variables fournies en entrée et la valeur obtenue en sortie. C'est le comportement attendu des fonctions mathématiques habituelles. Des fonctions de recopie sont fournies. Elles sont étanches à condition de leur fournir en argument des fonctions élémentaires de recopie des coefficients et des indices. Par composition, elle permettent d'étanchéifier toutes les fonctions voulues.

Ce module est inspiré du module Hashtbl de la bibliothèque standard d'OCaml.

Ce module est distribué selon la même licence qu'Ocaml.

Copyright Stéphane Grognet
Laboratoire de mathématiques Jean Leray UMR 6629 CNRS
Fédération de recherche mathématique des Pays de la Loire
Centre Henri Lebesgue
IREM des Pays de la Loire - Université de Nantes
version 0.1
*)

(** @version 0.1 *)

(** @author Stéphane Grognet *)

(** @since 2013 *)





(**
§
*)

(**

Vecteurs creux à coefficients dans un annau commutatif

Sparse vectors with coefficients in a commutative rng

 *)

(**
*)





open Util ;;
open Data ;;
open Hash ;;



module Rng (Index:Data.Index_type) (Hasher:Hash.Hash_type with type t = Index.t) (Coeff:Data.Rng_coeff_type) = struct


(** The type elt consists in couples (index, weight) and is identified with the type elt of the following module H.

Le type elt est formé par couple (indice, poids) et est identifié avec le type elt du module H suivant. *)



type index = Index.t ;;

type coeff = Coeff.t ;;

type elt = index * coeff ;;


(** The module H provides the hash tables.

Le module H fournit les tables de hachage. *)



module H = ( Hash.Make (Index) (Hasher) (Coeff)
: sig
 include module type of Hash.Make (Index) (Hasher) (Coeff)
end
 with type elt := elt with type index = index with type weight = coeff ) ;;


(** The type t contains the hash table together with the dimension of the vector space.

Le type t contient la table de hachage avec la dimension de l'espace vectoriel. *)


type t = index * H.t ;;


(** The type t is that of the norm.

Le type u est celui de la norme. *)


type u = Coeff.u ;;


(** 
to_sparse hash_size vector
This function is not sealed.

Cette fonction n'est pas étanche. *)


let to_sparse = fun (size:int) (v:coeff array) ->
 let r = Array.length v
 and h = H.create size in
  for i = 0 to pred r do
   H.add h ( Index.from_int i , v.(i) ) ;
  done ;
  ( Index.from_int r , h ) ;;

(** 
auto_to_sparse vector
*)

let auto_to_sparse = function (v:coeff array) ->
 to_sparse ( -1 ) v ;;

(** 
first_non_zero vector
*)

let first_non_zero = function (( d , v ):t) ->
 let result = ref d in
  let f = function ( i , x ) -> if Index.compare i !result > 0 then result := i in
   H.iter f v ;
   !result ;;

(** 
last_non_zero vector
*)

let last_non_zero = function (( d , v ):t) ->
 let result = ref ( Index.witness () ) in
  let f = function ( i , x ) -> if Index.compare i !result > 0 then result := i in
   H.iter f v ;
   !result ;;

(** 
to_full vector
This function is not sealed.

Cette fonction n'est pas étanche. *)


let to_full = function (( d , v ) as x:t) ->
 let r = max ( Index.to_int d ) ( succ ( Index.to_int ( last_non_zero x ) ) ) in
  let y = Array.make r ( Coeff.zero () ) in
   let f = function ( i , z ) -> ( y.( Index.to_int i ) <- z ) in
    H.iter f v ; 
    y ;;

(** 
filling vector
*)

let filling = function (( d , v ):t) ->
 H.filling v ;;

(** 
dimension vector
*)

let dimension = function (( d , v ):t) ->
 Index.copy d ;;

(** 
info vector
*)

let info = function (( d , v ):t) ->
 ( Index.copy d , H.filling v ) ;;

(** 
size vector
*)

let size = function (( d , v ):t) ->
 H.size v ;;

(** 
null dimension
*)

let null = function (d:index) ->
 ( Index.copy d , H.create ( -1 ) ) ;;

(** 
zero unit
*)

let zero = function () ->
 ( Index.from_int 1 , H.create ( -1 ) )

(** 
to_string vector
*)

let to_string = function (( d , v ):t) ->
 let a = Index.to_string d
 and b = ref "" in
  let f = function ( i , z ) -> b := !b ^ "(" ^ ( Index.to_string i ) ^ "," ^ ( Coeff.to_string z ) ^ ");" in
 H.iter f v ;
 a ^ ":" ^ ( String.sub !b 0 ( max 0 ( pred ( String.length !b ) ) ) ) ;;

(** 
special_to_string dimension_separator beginning separator ending vector
*)

let special_to_string = fun (dim_sep:char) (beginning:string) (separator:string) (ending:string) (( d , v ):t) ->
 assert ( ( String.length beginning ) + 1 = String.length ending ) ;
 let a = Index.to_string d
 and b = ref "" in
  let f = function ( i , z ) -> b := !b ^ beginning ^ ( Index.to_string i ) ^ separator ^ ( Coeff.to_string z ) ^ ending in
 H.iter f v ;
 a ^ ( String.make 1 dim_sep ) ^ ( String.sub !b 0 ( max 0 ( pred ( String.length !b ) ) ) ) ;;

(** 
print vector
*)

let print = function (x:t) ->
 print_string ( to_string x ) ;
 print_newline () ;;

(** 
from_string size string
*)

let from_string = fun (size:int) (s:string) ->
 let f = fun boundary separator st ->
  begin
   let lst = String.length st in
    let str = String.sub st boundary ( max 0 ( lst - 2 * boundary ) ) in
     Str.split ( Str.regexp_string separator ) str
  end in
  let separation = String.index s ':' in
   let dimension = String.sub s 0 separation
   and sep = succ separation in
    try
     begin
      let content = String.sub s sep ( max 0 ( ( String.length s ) - sep ) ) in
       let listing = f 1 ");(" content
       and g = function st ->
        begin
         match f 0 "," st with
         | head :: tail -> ( Index.of_string head , Coeff.of_string ( List.hd tail ) )
         | _ -> failwith "Bad string in Sparse.Rng_vector.of_string."
        end in
        let h = H.of_list size ( List.rev_map g listing ) in
         ( Index.of_string dimension , h )
     end
    with _ ->
     null ( Index.of_string dimension ) ;;

(** 
special_from_string dimension_separator beginning separator ending size string
*)

let special_from_string = fun (dim_sep:char) (beginning:string) (separator:string) (ending:string) (size:int) (s:string) ->
 assert ( ( String.length beginning ) + 1 = String.length ending ) ;
 let f = fun boundary separator st ->
  begin
   let lst = String.length st in
    let str = String.sub st boundary ( max 0 ( lst - 2 * boundary ) ) in
     Str.split ( Str.regexp_string separator ) str
  end in
  let separation = String.index s dim_sep in
   let dimension = String.sub s 0 separation
   and sep = succ separation in
    try
     begin
      let content = String.sub s sep ( max 0 ( ( String.length s ) - sep ) ) in
       let listing = f ( String.length beginning ) ( ending ^ beginning ) content
       and g = function st ->
        begin
         match f 0 separator st with
         | head :: tail -> ( Index.of_string head , Coeff.of_string ( List.hd tail ) )
         | _ -> failwith "Bad string in Sparse.Rng_vector.of_string."
        end in
        let h = H.of_list size ( List.rev_map g listing ) in
         ( Index.of_string dimension , h )
     end
    with _ ->
     null ( Index.of_string dimension ) ;;

(** 
of_string string
*)

let of_string = fun (s:string) ->
 from_string ( -1 ) s ;;

(** 
copy vector
*)

let copy = function (( d , v ):t) ->
 let f = function ( i , x ) -> ( Index.copy i , Coeff.copy x ) in
  let vv = H.copy f v in
   ( Index.copy d , vv ) ;;


(** 
cleanup vector
This function is needed in case the indices are modified in place.

Cette fonction est nécessaire si l'on modifie en place les indices. *)


let cleanup = function (( d , v ):t) ->
 let s = H.size v in
  let t = if s >= 0 then max 1 s else s in
   H.resize t v ;;

(** 
resize size vector
*)

let resize = fun (n:int) (( d , v ):t) ->
 let t = if n >= 0 then max 1 n else n in
  H.resize t v ;;

(** 
elements vector
*)

let elements = function (( d , v ):t) ->
 H.elements v ;;


(** 
iter function vector
This function is applied in place.

Cette fonction est appliquée en place. *)


let iter = fun f (( d , v ):t) ->
 H.iter f v ;;

(** 
fold function vector init
*)

let fold = fun f (( d , v ):t) init ->
 H.fold f v init ;;

(** 
in_place_map function vector
*)

let in_place_map = fun f (( d , v ):t) ->
 H.in_place_map f v ;;

(** 
in_place_mapi function vector
*)

let in_place_mapi = fun f (( d , v ):t) ->
 H.in_place_mapi f v ;;

(** 
map function vector
*)

let map = fun f (( d , v ):t) ->
 ( Index.copy d , H.map f v ) ;;

(** 
mapi function vector
*)

let mapi = fun f (( d , v ):t) ->
 ( Index.copy d , H.mapi f v ) ;;

(** 
min vector
*)

let min = function (( d , v ):t) ->
 H.min v ;;

(** 
max vector
*)

let max = function (( d , v ):t) ->
 H.max v ;;

(** 
unsafe_extract index vector
*)

let unsafe_extract = fun (i:index) (( d , v ):t) ->
 H.extract i v ;;

(** 
extract index vector
*)

let extract = fun (i:index) (( d , v ):t) ->
 try
  H.extract i v
 with _ -> ( Index.zero () , Coeff.zero () ) ;;

(** 
raw_extract index vector
*)

let raw_extract = fun (i:index) (x:t) ->
 snd ( extract i x ) ;;

(** 
filter predicate vector
*)

let filter = fun (p:index -> bool) (( d , v ):t) ->
 let result = ref [] in
  let f = function ( i , x ) -> if p(i) then result := ( i , x ) :: !result in
   H.iter f v ;
   !result ;;


(** 
insert_add coefficient index vector
This function is applied in place.

Cette fonction est appliquée en place. *)


let insert_add = fun (x:coeff) (i:index) (( d , v ):t) ->
 H.add v ( i , x ) ;;


(** 
insert_sub coefficient index vector
This function is applied in place.

Cette fonction est appliquée en place. *)


let insert_sub = fun (x:coeff) (i:index) (( d , v ):t) ->
 H.sub v ( i , x ) ;;


(** 
replace coefficient index vector
This function is applied in place.

Cette fonction est appliquée en place. *)


let replace = fun (x:coeff) (i:index) (( d , v ):t) ->
 H.replace v ( i , x ) ;;


(** 
remove index vector
This function is applied in place.

Cette fonction est appliquée en place. *)


let remove = fun (i:index) (( d , v ) as x:t) ->
 let x = raw_extract i x in
  H.remove v ( i , x ) ;;

(** 
beginning index vector
*)

let beginning = fun (i:index) (( d , v ) as x :t) ->
 let w = null d in
  let f = function ( j , y ) -> if ( Index.compare j i <= 0 ) && ( Index.compare j ( Index.zero () ) >= 0 ) then insert_add y j w in
   iter f x ;
   w ;;

(** 
ending index vector
*)

let ending = fun (i:index) (( d , v ) as x :t) ->
 let w = null d in
  let f = function ( j , y ) -> if ( Index.compare j i >= 0 ) && ( Index.compare j d < 0 ) then insert_add y j w in
   iter f x ;
   w ;;


(** 
in_place_add vector1 vector2
The first vector stores the result.

Le premier vecteur accueille le résultat. *)


let in_place_add = fun (( d , v ):t) (( e , w ):t) ->
 let f = function x -> H.add v x in
  H.iter f w ;;

(** 
add vector1 vector2
*)

let add = fun (( d , v ) as x:t) (( e , w ) as y:t) ->
 let xx = copy x in
  in_place_add xx y ;
  xx ;;


(** 
in_place_sub vector1 vector2
The first vector stores the result.

Le premier vecteur accueille le résultat. *)


let in_place_sub = fun (( d , v ):t) (( e , w ):t) ->
 let f = function x -> H.sub v x in
  H.iter f w ;;

(** 
sub vector1 vector2
*)

let sub = fun (( d , v ) as x:t) (( e , w ) as y:t) ->
 let xx = copy x in
  in_place_sub xx y ;
  xx ;;

(** 
eq_zero vector
*)

let eq_zero = function (( d , v ):t) ->
 ( H.filling v ) = 0 ;;

(** 
eq vector1 vector2
*)

let eq = fun (x:t) (y:t) ->
 eq_zero ( sub x y ) ;;

(** 
in_place_opp vector
*)

let in_place_opp = function (( d , v ):t) ->
 H.in_place_opp v ;;

(** 
opp vector
*)

let opp = function (( d , v ):t) ->
 ( Index.copy d , H.opp v ) ;;

(** 
sub_vector beginning ending vector
*)

let sub_vector = fun (beginning:index) (ending:index) (( d , v ) as x:t) ->
 let h = H.create ( size x ) in
  let f = function ( i , y ) ->
   if ( Index.compare i beginning >= 0 ) && ( Index.compare i ending <= 0 ) then
    H.add h ( Index.sub i beginning , y ) in
   H.iter f v ;
   ( Index.succ ( Index.sub ending beginning ) , h ) ;;

(** 
mask_vector beginning ending vector
*)

let mask_vector = fun (beginning:index) (ending:index) (( d , v ) as x:t) ->
 let h = H.create ( size x ) in
  let f = function ( i , y ) ->
   if ( Index.compare i beginning >= 0 ) && ( Index.compare i ending <= 0 ) then
    H.add h ( i , y ) in
   H.iter f v ;
   ( d , h ) ;;

(** 
embed dimension shift vector
*)

let embed = fun (dimension:index) (shift:index) (( d , v ) as x:t) ->
 assert ( Index.compare dimension ( Index.add shift d ) >= 0 ) ;
 let h = H.create ( size x ) in
  let f = function ( i , y ) -> H.add h ( Index.add shift i , y ) in
   H.iter f v ;
   ( dimension , h ) ;;

(** 
find coefficient vector
*)

let find = fun (c:coeff) (( d , v ) :t) ->
 try
  fst ( H.load_find v c )
 with _ ->
  Index.witness () ;;

(** 
find_all coefficient vector
*)

let find_all = fun (c:coeff) (( d , v ) :t) ->
 H.load_find_all v c ;;

(** 
list_find_all coefficient vector
*)

let list_find_all = fun (c:coeff) (( d , v ) :t) ->
 H.B.E.elements ( H.load_find_all v c ) ;;

(** 
index_list_find_all coefficient vector
*)

let index_list_find_all = fun (c:coeff) (( d , v ) :t) ->
 List.rev_map fst ( H.B.E.elements ( H.load_find_all v c ) ) ;;

(** 
sum vector
*)

let sum = function (x:t) ->
 let accu = ref ( Coeff.zero () ) in
  let f = function ( i , y ) -> accu := Coeff.add !accu y in
   ignore ( iter f x ) ;
   !accu ;;

(** 
contraction init vector
*)

let contraction = fun (init:coeff) (x:t) ->
 let accu = ref init in
  let f = function ( i , y ) -> accu := Coeff.mult !accu y in
   ignore ( iter f x ) ;
   !accu ;;

(** 
in_place_scal_add scalar vector
*)

let in_place_scal_add = fun (y:coeff) (( d , v ):t) ->
 H.in_place_map ( Coeff.add y ) v ;;

(** 
scal_add scalar vector
*)

let scal_add = fun (y:coeff) (( d , v ):t) ->
 let h = H.map ( Coeff.add y ) v in
  ( Index.copy d , h ) ;;

(** 
in_place_scal_mult scalar vector
*)

let in_place_scal_mult = fun (y:coeff) (( d , v ):t) ->
 H.in_place_map ( Coeff.mult y ) v ;;

(** 
scal_mult scalar vector
*)

let scal_mult = fun (y:coeff) (( d , v ):t) ->
 let h = H.map ( Coeff.mult y ) v in
  ( Index.copy d , h ) ;;

(** 
in_place_scal_right_sub scalar vector
*)

let in_place_scal_right_sub = fun (y:coeff) (( d , v ):t) ->
 H.in_place_map ( Coeff.sub y ) v ;;

(** 
scal_right_sub scalar vector
*)

let scal_right_sub = fun (y:coeff) (( d , v ):t) ->
 let h = H.map ( Coeff.sub y ) v in
  ( Index.copy d , h ) ;;

(** 
in_place_scal_left_sub scalar vector
*)

let in_place_scal_left_sub = fun (y:coeff) (( d , v ):t) ->
 let f = function z -> Coeff.sub z y in
  H.in_place_map f v ;;

(** 
scal_left_sub scalar vector
*)

let scal_left_sub = fun (y:coeff) (( d , v ):t) ->
 let f = function z -> Coeff.sub z y in
  let h = H.map f v in
  ( Index.copy d , h ) ;;

(** 
coeff_prod vector1 vector2
*)

let coeff_prod = fun (x:t) (y:t) ->
 let result = null ( dimension x ) in
  let f = function ( i , z ) ->
   begin
    let zz = raw_extract i x in
     insert_add ( Coeff.mult zz z ) i result
   end in
   iter f y ;
   result ;;

(** 
scal_prod vector1 vector2
*)

let scal_prod = fun (( d , v ):t) (( e , w ):t) ->
 let f = fun ( i , x ) previous ->
  begin
   try
    begin
     let zz = H.extract i w in
      Coeff.add previous ( Coeff.mult x ( snd zz ) )
    end
   with _ ->
    previous
  end in
  H.fold f v ( Coeff.zero () ) ;;

(** 
sparse_full_scal_prod vector1 vector2
*)

let sparse_full_scal_prod = fun (( d , v ):t) (w:coeff array) ->
 let f = fun ( i , x ) previous ->
  begin
   try
    begin
     let zz = w.( Index.to_int i ) in
      Coeff.add previous ( Coeff.mult x zz )
    end
   with _ ->
    previous
  end in
  H.fold f v ( Coeff.zero () ) ;;

(** 
norm_1 vector
*)

let norm_1 = function (x:t) ->
 let accu = ref ( Coeff.norm_zero () ) in
  let f = function ( i , y ) -> accu := Coeff.norm_add !accu ( Coeff.norm y ) in
   ignore ( iter f x ) ;
   !accu ;;

(** 
norm_inf vector
*)

let norm_inf = function (x:t) ->
 let accu = ref ( Coeff.norm_zero () ) in
  let f = function ( i , y ) ->
   begin
    let new_norm = Coeff.norm y in
     if Coeff.norm_compare new_norm !accu > 0 then
      accu := new_norm
   end in
   ignore ( iter f x ) ;
   !accu ;;

(** 
square_sum vector
*)

let square_sum = function (x:t) ->
 let accu = ref ( Coeff.zero () ) in
  let f = function ( i , y ) -> accu := Coeff.add !accu ( Coeff.mult y y ) in
   ignore ( iter f x ) ;
   !accu ;;

(** 
square_norm_2 vector
*)

let square_norm_2 = function (x:t) ->
 let accu = ref ( Coeff.norm_zero () ) in
  let f = function ( i , y ) -> accu := Coeff.norm_add !accu ( Coeff.norm ( Coeff.mult y y ) ) in
   ignore ( iter f x ) ;
   !accu ;;

(** 
compare_norm norm vector1 vector2
*)

let compare_norm = fun n (x:t) (y:t) ->
 Coeff.norm_compare ( n x ) ( n y ) ;;

(** 
exchange index_1 index_2 vector
*)
 
let exchange = fun (i:index) (j:index) (u:t) ->
 let ( ii , x ) = extract i u
 and ( jj , y ) = extract j u in
  replace x j u ;
  replace y i u ;;

(** 
compare vector1 vector2
*)

let compare = compare_norm norm_1 ;;

(** 
mult vector1 vector2
*)

let mult = coeff_prod ;;

(** 
square vector1 vector2
*)

let square = function x ->
 mult x x ;;

(** 
int_mult integer vector
*)

let int_mult = fun (n:int) (( d , v ):t) ->
 let h = H.map ( Coeff.int_mult n ) v in
  ( Index.copy d , h ) ;;

(** 
int_pow integer vector
*)

let int_pow = fun (n:int) (( d , v ):t) ->
 let h = H.map ( Coeff.int_pow n ) v in
  ( Index.copy d , h ) ;;

(** 
norm vector
*)

let norm = norm_1 ;;

(** 
norm_inject number
*)

let norm_inject = function (x:u) -> auto_to_sparse [| Coeff.norm_inject x |] ;;

(** 
norm_zero unit
*)

let norm_zero = function () ->
 Coeff.norm_zero () ;;

(** 
norm_of_string string
*)

let norm_of_string = Coeff.norm_of_string ;;

(** 
norm_to_string number
*)

let norm_to_string = Coeff.norm_to_string ;;

(** 
norm_print number
*)

let norm_print = Coeff.norm_print ;;

(** 
norm_eq number1 number2
*)

let norm_eq = Coeff.norm_eq ;;

(** 
norm_eq_zero number
*)

let norm_eq_zero = Coeff.norm_eq_zero ;;

(** 
norm_compare number1 number2
*)

let norm_compare = Coeff.norm_compare ;;

(** 
norm_add number1 number2
*)

let norm_add = Coeff.norm_add ;;

(** 
norm_int_mult integer number
*)

let norm_int_mult = Coeff.norm_int_mult ;;

(** 
norm_mult number1 number2
*)

let norm_mult = Coeff.norm_mult ;;

(** 
norm_square number1 number2
*)

let norm_square = Coeff.norm_square ;;




(**
§ § §
*)





end ;;




(**
§
*)

(**

Vecteurs creux à coefficients dans un corps commutatif

Sparse vectors with coefficients in a field

 *)

(**
*)





module Field (Index:Data.Index_type) (Hasher:Hash.Hash_type with type t = Index.t) (Coeff:Data.Field_coeff_type) = struct


include Rng (Index) (Hasher) (Coeff) ;;


(** 
in_place_inv vector
*)

let in_place_inv = function (( d , v ):t) ->
 H.in_place_map Coeff.inv v ;;

(** 
inv vector
*)

let inv = function (( d , v ):t) ->
 ( Index.copy d , H.map Coeff.inv v ) ;;

(** 
in_place_scal_right_div scalar vector
*)

let in_place_scal_right_div = fun (y:coeff) (( d , v ):t) ->
 H.in_place_map ( Coeff.div y ) v ;;

(** 
scal_right_div scalar vector
*)

let scal_right_div = fun (y:coeff) (( d , v ):t) ->
 let h = H.map ( Coeff.div y ) v in
  ( Index.copy d , h ) ;;

(** 
in_place_scal_left_div scalar vector
*)

let in_place_scal_left_div = fun (y:coeff) (( d , v ):t) ->
 let f = function z -> Coeff.div z y in
  H.in_place_map f v ;;

(** 
scal_left_div scalar vector
*)

let scal_left_div = fun (y:coeff) (( d , v ):t) ->
 let f = function z -> Coeff.div z y in
  let h = H.map f v in
  ( Index.copy d , h ) ;;

(** 
reciprocal vector
*)

let reciprocal = function (v:t) ->
 scal_left_div ( square_sum v ) v ;;

(** 
norm_reciprocal vector
*)

let norm_reciprocal = function (v:t) ->
 scal_left_div ( Coeff.norm_inject ( square_norm_2 v ) ) v ;;





(**
§ § §
*)





end ;;








(**
§ § §
*)





end ;;








module Sparse_tensor = struct




(**
§
*)

(**

Introduction

 *)

(**
*)




(** The mathematician will find in this module functors to handle sparse tensors with coefficients in a commutative rng or a field.

Conventions

Dimensions are often unreachable in a sparse tensor as soon as it is null (excepted sometimes for the first variable).

Comments

A function is sealed if there is no sharing between the input variables and the output value. This is the expected behavior of usual mathematical functions. The recursive programming of polymorphic functions is easier in a non sealed way. Some copy functions are provided for every type of data. They are sealed provided that they receive as argument elementary copy functions for coefficients and indices. By composition, they permit to seal all functions necessary.

This module is distributed under the same licence as Ocaml.

§

La mathématicienne ou le mathématicien trouvera dans ce module des foncteurs pour traiter les tenseurs creux à coefficients dans un annau commutatif ou un corps commutatif.

Conventions

Les dimensions d'un tenseur creux sont souvent inaccessibles (sauf parfois pour la première variable) dès qu'il est nul.

Commentaires

Une fonction est étanche quand il n'y a aucun partage entre les variables fournies en entrée et la valeur obtenue en sortie. C'est le comportement attendu des fonctions mathématiques habituelles. La programmation récursive des fonctions polymorphes est plus facile de manière non étanche. Des fonctions de recopie sont fournies pour tous les types de données. Elles sont étanches à condition de leur fournir en argument des fonctions élémentaires de recopie des coefficients et des indices. Par composition, elle permettent d'étanchéifier toutes les fonctions voulues.

Ce module est distribué selon la même licence qu'Ocaml.

Copyright Stéphane Grognet
Laboratoire de mathématiques Jean Leray UMR 6629 CNRS
Fédération de recherche mathématique des Pays de la Loire
Centre Henri Lebesgue
IREM des Pays de la Loire - Université de Nantes
version 0.1
*)

(** @version 0.1 *)

(** @author Stéphane Grognet *)

(** @since 2013 *)





(**
§
*)

(**

Tenseurs creux à coefficients dans un annau commutatif

Sparse tensors with coefficients in a commutative rng

 *)

(**
*)





open Util ;;
open Data ;;
open Hash ;;
open Sparse_vector ;;



module Rng (Index:Data.Index_type) (Hasher:Hash.Hash_type with type t = Index.t) (Coeff:Data.Rng_coeff_type) = struct



type index = Index.t ;;

type coeff = Coeff.t ;;

type elt = index * coeff ;;


module V = Sparse_vector.Rng (Index) (Hasher) (Coeff) ;;


(** Sparse tensors are built in a flat manner as sparse vectors with multi-indices.

Les tenseurs creux sont construits à plat comme des vecteurs creux avec des multi-indices. *)



module Multi_index = Data.Multi_index (Index) ;;


module Multi_hasher = Hash.Multi_hasher (Index) (Hasher) ;;


module M = Sparse_vector.Rng (Multi_index) (Multi_hasher) (Coeff) ;;


(** In order to have access to the different levels of a tensor, the coordinates of a multi-index are necessary.

Pour accéder aux différents niveaux d'un tenseur, les coordonnées d'un multi-indice sont nécessaires. *)




module Multi_hash = Sparse_vector.Rng (Multi_index) (Multi_hasher) (Data.Zcoeff) ;;


module Info = Sparse_vector.Rng (Index) (Hasher) (Multi_hash) ;;





(** The type t is either a sparse vector or a flat tensor which contains the thickness, the information tree and the multi-indices vector.

Le type t est soit un vecteur creux soit un tenseur à plat qui contient l'épaisseur, l'arbre d'information et le vecteur à multi-indices. *)


type t =
 | Vector of V.t
 | Flat_tensor of int * Info.t array * M.t ;;


(**

Pour trouver les éléments du tenseur dont le kème indice est i, on extrait le kème élément du tableau qui est de type Info.t. Dans ce vecteur, on extrait l'élément de coordonnée Hasher.hash i (la dimension est toujours 1) . Cet élément est un vecteur creux dont les indices sont des multi-entiers et les coefficients sont les valeurs de hachage des multi-indices du tenseur (la dimension est toujours Array.make (e+1) 1). L'indice est la valeur de hachage du kème indice. Les réponses sont dedans, il faut continuer avec des tests sur le tenseur lui-même, mais seulement en extrayant les éléments dont la valeur de hachage est lue dans les coefficients des éléments de ce vecteur. Il est possible de sélectionner en deuxième étape des contraintes supplémentaires sur l'ensemble des indices en testant les multi_indices de ce vecteur (attention à la permutation circulaire).

Attention ! les vecteurs Info.t peuvent donner des coefficients nuls dans la lecture du tenseur parce qu'il est difficile d'effacer dans le tableau d'information lors d'une modification en place. *)





(** 
copy tensor
*)

let copy = function (w:t) ->
 match w with
 | Vector v -> Vector ( V.copy v )
 | Flat_tensor ( e , t , v ) -> Flat_tensor ( e , Array.map Info.copy t , M.copy v ) ;;

(** 
info_augment tensor
*)

let info_augment = function (w:t) ->
 match w with
 | Vector v -> ()
 | Flat_tensor ( e , t , v ) ->
  begin
   let f = function ( index , coefficient ) ->
    begin
     let h = Multi_hasher.hash index in
      for j = 0 to e do
       let information = t.(j)
       and i = index.(j) in
        let x = Info.raw_extract i information in
         Multi_hash.replace h index x ;
         Info.replace x i information ;
      done ;
    end in
    M.iter f v
  end ;;

(** 
info_cleanup tensor
*)

let info_cleanup = function (w:t) ->
 match w with
 | Vector v -> ()
 | Flat_tensor ( e , t , v ) ->
  begin
   let ( dim , table ) = v in
    let s = Array.length table.M.H.data in
     let f = fun x ( index , coefficient ) ->
      begin
       let ensemble = table.M.H.data.( coefficient mod s )
       and p = function ( i , z ) -> Multi_index.eq i index in
        if not ( M.H.B.exists p ensemble ) then
         Multi_hash.remove index x
      end in
      let g = function ( index , coefficient ) -> Multi_hash.iter ( f coefficient ) coefficient in
      for i = 0 to e do
       let information = t.(i) in
        Info.iter g information ;
        Info.cleanup information ;
      done ;
  end ;;

(** 
info_update tensor
*)

let info_update = function (w:t) ->
 info_augment w ;
 info_cleanup w ;;


(** 
cleanup tensor
This function is applied in place.

Cette fonction est appliquée en place. *)


let cleanup = function (w:t) ->
 match w with
 | Vector v -> V.cleanup v
 | Flat_tensor ( e , t , v ) ->
  begin
   M.cleanup v ;
   info_update w ;
  end ;;

(** 
resize size tensor
*)

let resize = fun (n:int) (w:t) ->
 match w with
 | Vector v -> V.resize n v
 | Flat_tensor ( e , t , v ) -> M.resize n v ;;

(** 
thickness tensor
*)

let thickness = function (w:t) ->
 match w with
 | Vector v -> 0
 | Flat_tensor ( e , t , v ) -> e ;;

(** 
vector_demakeup tensor
*)

let vector_demakeup = function (w:t) ->
 match w with
 | Vector v -> v
 | Flat_tensor ( e , t , v ) -> failwith "Not a Vector in Sparse.Rng_tensor.vector_demakeup." ;;

(** 
flat_tensor_demakeup tensor
*)

let flat_tensor_demakeup = function (w:t) ->
 match w with
 | Vector v -> failwith "Not a Flat_tensor in Sparse.Rng_tensor.flat_tensor_demakeup."
 | Flat_tensor ( e , t , v ) -> ( e , t , v ) ;;

(** 
flat_tensor_info tensor
*)

let flat_tensor_info = function (w:t) ->
 match w with
 | Vector v -> failwith "Not a Flat_tensor in Sparse.Rng_tensor.flat_tensor_info."
 | Flat_tensor ( e , t , v ) -> v ;;

(** 
flat_tensor_bare_demakeup tensor
*)

let flat_tensor_bare_demakeup = function (w:t) ->
 match w with
 | Vector v -> failwith "Not a Flat_tensor in Sparse.Rng_tensor.flat_tensor_bare_demakeup."
 | Flat_tensor ( e , t , v ) -> v ;;

(** 
null multi_dimension
*)

let null = function (i:index array) ->
 let ee = Array.length i in
  Flat_tensor ( pred ee , Array.map Info.null ( Array.map Index.zero ( Array.make ee () ) ) , M.null i ) ;;

(** 
zero unit
*)

let zero = function () ->
 Vector ( V.zero () ) ;;

(** 
dimensions tensor
*)

let dimensions = function (w:t) ->
 match w with
 | Vector v -> [| V.dimension v |]
 | Flat_tensor ( e , t , v ) -> M.dimension v ;;

(** 
filling tensor
*)

let filling = function (w:t) ->
 match w with
 | Vector v -> V.filling v
 | Flat_tensor ( e , t , v ) -> M.filling v ;;

(** 
sizes tensor
*)

let sizes = function (w:t) ->
 match w with
 | Vector v -> ( V.size v , [| |] )
 | Flat_tensor ( e , t , v ) -> ( M.size v , Array.map Info.size t ) ;;

(** 
size tensor
*)

let size = function (w:t) ->
 match w with
 | Vector v -> V.size v
 | Flat_tensor ( e , t , v ) -> M.size v ;;

(** 
eq_zero tensor
*)

let eq_zero = function (w:t) ->
 match w with
 | Vector v -> V.eq_zero v
 | Flat_tensor ( e , t , v ) -> M.eq_zero v ;;

(** 
in_place_opp tensor
*)

let in_place_opp = function (w:t) ->
 match w with
 | Vector v -> V.in_place_opp v
 | Flat_tensor ( e , t , v ) -> M.in_place_opp v ;;

(** 
opp tensor
*)

let opp = function (w:t) ->
 match w with
 | Vector v -> Vector ( V.opp v )
 | Flat_tensor ( e , t , v ) -> Flat_tensor ( e , Array.map Info.copy t , M.opp v ) ;;

(** 
flatten tensor
*)

let flatten = function (w:t) ->
 match w with
 | Vector v ->
  begin
   let d = V.dimension v
   and t = [| Info.zero () |]
   and f = V.filling v
   and accu = ref ( M.H.B.empty () )
   and table = snd v in
    let source = ( snd v ).V.H.data
    and h = function ( i , x ) ->
     begin
      let ii = [| i |] in
       let x = Multi_hash.null [| Index.zero () |] in
        Multi_hash.insert_add ( Multi_hasher.hash ii ) ii x ;
        Info.insert_add x i t.(0)
     end
    and g = fun ( i , x )-> M.H.B.add ( [| i |] , x ) !accu in
     V.iter h v ;
     let r = Array.length source in
      let goal = ( M.H.create r ).M.H.data in
       for i = 0 to pred r do
        V.H.B.iter g source.(i) ;
        goal.(i) <- !accu ;
        accu := M.H.B.empty () ;
       done ;
       let vv = ( [| d |] , { M.H.filling = f ; M.H.auto = table.V.H.auto ; M.H.data = goal } ) in
       Flat_tensor ( 0 , t , vv )
  end
 | Flat_tensor ( e , t , v ) -> w ;;

(** 
tensor_to_vector tensor
*)

let tensor_to_vector = function (w:t) ->
 match w with
 | Vector v -> w
 | Flat_tensor ( e , t , v ) ->
  begin
   if e <> 0 then failwith "Bad thickness in Sparse.Rng_tensor.tensor_to_vector." ;
   let d = M.dimension v
   and f = M.filling v
   and accu = ref ( V.H.B.empty () )
   and source = ( snd v ).M.H.data in
    let r = Array.length source
    and g = fun ( i , x )-> V.H.B.add ( i.(0) , x ) !accu in
     let goal = ( V.H.create r ).V.H.data in
      for i = 0 to pred r do
       M.H.B.iter g source.(i) ;
       goal.(i) <- !accu ;
       accu := V.H.B.empty () ;
      done ;
      Vector ( d.(0) , { V.H.filling = f ; V.H.auto = ( snd v ).M.H.auto ; V.H.data = goal } )
  end ;;

(** 
to_string tensor
*)

let rec to_string = function (w:t) ->
 match w with
 | Vector v -> to_string ( flatten w )
 | Flat_tensor ( e , t , v ) ->
  begin
   let ee = string_of_int e
   and tt = Util.vector_to_string ( Info.special_to_string '!' "<" "@" ">;" ) "{" "_" "}" t
   and vv = M.to_string v in
    "(" ^ ee ^ "#" ^ tt ^ "#" ^ vv ^ ")"
  end ;;

(** 
bare_to_string tensor
*)

let rec bare_to_string = function (w:t) ->
 match w with
 | Vector v -> to_string ( flatten w )
 | Flat_tensor ( e , t , v ) ->
  begin
   let ee = string_of_int e
   and vv = M.to_string v in
    "(" ^ ee ^ "#" ^ vv ^ ")"
  end ;;

(** 
of_string string
*)

let rec of_string = function (s:string) ->
 let a = ref ( String.index s '#' ) in
  let e = int_of_string ( String.sub s 1 ( max 0 ( pred !a ) ) )
  and rest = ref ( String.sub s ( !a + 1 ) ( max 0 ( String.length s - 2 - !a ) ) ) in
   a := String.index !rest '#' ;
   let t = ref ( Array.map Info.null ( Array.map Index.zero ( Array.make ( succ e ) () ) ) ) in
    let chaine = String.sub !rest 0 ( max 0 ( !a ) ) in
     t := Util.vector_of_string ( Info.special_from_string '!' "<" "@" ">;" (-1) ) "{" "_" "}" chaine ;
     rest := String.sub !rest ( !a + 1 ) ( max 0 ( String.length !rest - 1 - !a ) ) ;
     let v = M.of_string !rest in
      Flat_tensor ( e , !t , v ) ;;

(** 
print tensor
*)

let print = function (w:t) ->
 print_string ( to_string w ) ;;

(** 
eq tensor1 tensor2
*)

let rec eq = fun (w:t) (x:t) ->
 match w with
 | Vector v ->
  begin
   match x with
   | Vector y -> V.eq v y
   | Flat_tensor ( ee , tt , y ) -> ( ee = 0 ) && ( eq w ( tensor_to_vector x ) )
  end
 | Flat_tensor ( e , t , v ) ->
  begin
   match x with
   | Vector y -> eq ( tensor_to_vector w ) x
   | Flat_tensor ( ee , tt , y ) -> ( e = ee ) && ( Util.array_eq Info.eq t tt ) && ( M.eq v y )
  end ;;

(** 
unsafe_extract index_array tensor
*)

let unsafe_extract = fun (i:index array) (w:t) ->
 let e = Array.length i in
  match w with
  | Vector v ->
   begin
    if e <> 0 then failwith "Bad thickness in Sparse.Rng_tensor.unsafe_extract." ;
    let ( j , x ) = V.unsafe_extract i.(0) v in
     ( [| j |] , x )
   end
  | Flat_tensor ( ee , t , v ) ->
   begin
    if e <> ee then failwith "Bad thickness in Sparse.Rng_tensor.unsafe_extract." ;
    M.unsafe_extract i v
   end ;;

(** 
extract index_array tensor
*)

let extract = fun (i:index array) (w:t) ->
 let e = pred ( Array.length i ) in
  match w with
  | Vector v ->
   begin
    if e <> 0 then failwith "Bad thickness in Sparse.Rng_tensor.extract." ;
    let ( j , x ) = V.extract i.(0) v in
     ( [| j |] , x )
   end
  | Flat_tensor ( ee , t , v ) ->
   begin
    if e <> ee then failwith "Bad thickness in Sparse.Rng_tensor.extract." ;
    M.extract i v
   end ;;

(** 
raw_extract index_array tensor
*)

let raw_extract = fun (i:index array) (w:t) ->
 snd ( extract i w ) ;;

(** 
is_present index_array tensor
*)

let is_present = fun (i:index array) (w:t) ->
 let e = pred ( Array.length i )
 and ee = thickness w in
  if e <> ee then failwith "Bad thickness in Sparse.Rng_tensor.is_present." ;
  try
   begin
    ignore ( unsafe_extract i w ) ;
    true
   end
  with _ -> false ;;

(** 
find coefficient tensor
*)

let find = fun (c:coeff) (w:t) ->
 match w with
 | Vector v -> [| V.find c v |]
 | Flat_tensor ( e , t , v ) ->
  begin
   let index = M.find c v
   and ee = succ e in
    if Array.length index < ee then
     Array.map Index.witness ( Array.make ee () ) 
    else
     index
  end ;;

(** 
list_find_all coefficient tensor
*)

let list_find_all = fun (c:coeff) (w:t) ->
 match w with
 | Vector v ->
  begin
   let f = function ( i , x ) -> ( [| i |] , x ) in
    List.rev_map f ( V.list_find_all c v )
  end
 | Flat_tensor ( e , t , v ) -> M.list_find_all c v ;;

(** 
index_list_find_all coefficient tensor
*)

let index_list_find_all = fun (c:coeff) (w:t) ->
 match w with
 | Vector v -> List.rev_map ( Array.make 1 ) ( V.index_list_find_all c v )
 | Flat_tensor ( e , t , v ) -> M.index_list_find_all c v ;;

(** 
filter predicate tensor
*)

let filter = fun (p:index array -> bool) (w:t) ->
 match w with
 | Vector v ->
  begin
   let f = function ( i , x ) -> ( [| i |] , x ) in
    List.rev_map f ( V.filter ( function i -> p [| i |] ) v )
  end
 | Flat_tensor ( e , t , v ) -> M.filter p v ;;

(** 
sub_tensor_extract level index tensor
*)

let rec sub_tensor_extract = fun (k:int) (i:index) (w:t) ->
 match w with
 | Vector v ->
  begin
   assert ( k = 0 ) ;
   let z = V.null ( Index.zero () ) in
    V.insert_add ( V.raw_extract i v ) ( Index.witness () ) z ;
    Vector z
  end
 | Flat_tensor ( e , t , v ) ->
  begin
   if e = 0 then
    sub_tensor_extract k i ( tensor_to_vector w )
   else
    begin
     try
      begin
       let ( dim , table ) = v
       and ee = pred e
       and tt = Array.map ( Info.null ) ( Array.map Index.zero ( Array.make ( succ e ) () ) )
       and hints = t.(k) in
        let d = Util.array_forget k dim
        and range = Info.raw_extract i hints in
         let result = M.null d
         and candidates = Multi_hash.elements range in
          let ( indices , hash_values ) = List.split candidates
          and f = function ( index , coefficient ) ->
           begin
            if Index.eq i index.(k) then
             begin
              let new_index = Util.array_forget k index in
               let h = Multi_hasher.hash new_index in
                for level = 0 to ee do
                 let indice = new_index.(level)
                 and ttt = tt.(level) in
                  let element = Info.raw_extract indice ttt in
                   Multi_hash.replace h new_index element ;
                   Info.replace element indice ttt ;
                done
             end
           end
          and g = function ( index , coefficient ) ->
           begin
            if Index.eq i index.(k) then
             begin
              let new_index = Util.array_forget k index in
               M.replace coefficient new_index result ;
             end
           end in
           let hv = Array.of_list hash_values
           and taille = Array.length table.M.H.data in
            let u = table.M.H.data.( hv.(0) mod taille ) in
             M.H.B.iter f u ;
             M.H.B.iter g table.M.H.data.( hv.(0) mod taille ) ;
             for j = 1 to pred ( Array.length hv ) do
              let s = table.M.H.data.( hv.(j) mod taille ) in
               M.H.B.iter f s ;
             done ;
             Flat_tensor ( ee , tt , result )
      end
     with _ ->
      begin
       let d = Util.array_forget k ( dimensions w ) in
        Flat_tensor ( pred e , Array.map Info.null ( Array.map Index.zero ( Array.make e () ) ) , M.null d )
      end
    end
  end ;;


(** 
insert_add coefficient index_array tensor
This function is applied in place.

Cette fonction est appliquée en place. *)


let insert_add = fun (x:coeff) (i:index array) (w:t) ->
 if ( Array.length i ) <> ( succ ( thickness w ) ) then failwith "Bad thickness in Sparse.Rng_tensor.insert." ;
 match w with
 | Vector v -> V.insert_add x i.(0) v
 | Flat_tensor ( e , t , v ) ->
  begin
   M.insert_add x i v ;
   let test = M.raw_extract i v in
    if not ( Coeff.eq_zero test ) then
     begin
      let h = Multi_hasher.hash i in
       for level = 0 to e do
        let indice = i.(level) in
         let element = Info.raw_extract indice t.(level) in
          Multi_hash.replace h i element ;
          Info.replace element indice t.(level) ;
       done ;
     end
  end ;;


(** 
insert_sub coefficient index_array tensor
This function is applied in place.

Cette fonction est appliquée en place. *)


let insert_sub = fun (x:coeff) (i:index array) (w:t) ->
 if ( Array.length i ) <> ( succ ( thickness w ) ) then failwith "Bad thickness in Sparse.Rng_tensor.insert." ;
 match w with
 | Vector v -> V.insert_sub x i.(0) v
 | Flat_tensor ( e , t , v ) ->
  begin
   M.insert_sub x i v ;
   let test = M.raw_extract i v in
    if not ( Coeff.eq_zero test ) then
     begin
      let h = Multi_hasher.hash i in
       for level = 0 to e do
        let indice = i.(level) in
         let element = Info.raw_extract indice t.(level) in
          Multi_hash.replace h i element ;
          Info.replace element indice t.(level) ;
       done ;
     end
  end ;;


(** 
replace coefficient index_array tensor
This function is applied in place.

Cette fonction est appliquée en place. *)


let replace = fun (x:coeff) (i:index array) (w:t) ->
 if ( Array.length i ) <> ( succ ( thickness w ) ) then failwith "Bad thickness in Sparse.Rng_tensor.replace." ;
 match w with
 | Vector v -> V.replace x i.(0) v
 | Flat_tensor ( e , t , v ) ->
  begin
   M.replace x i v ;
   let test = M.raw_extract i v in
    if not ( Coeff.eq_zero test ) then
     begin
      let h = Multi_hasher.hash i in
       for level = 0 to e do
        let indice = i.(level) in
         let element = Info.raw_extract indice t.(level) in
          Multi_hash.replace h i element ;
          Info.replace element indice t.(level) ;
       done ;
     end
  end ;;


(** 
remove index_array tensor
This function is applied in place.

Cette fonction est appliquée en place. *)


let remove = fun (i:index array) (w:t) ->
 if ( Array.length i ) <> ( succ ( thickness w ) ) then failwith "Bad thickness in Sparse.Rng_tensor.remove." ;
 match w with
 | Vector v -> V.remove i.(0) v
 | Flat_tensor ( e , t , v ) ->
  begin
   let test = M.raw_extract i v in
    if not ( Coeff.eq_zero test ) then
     begin
      for level = 0 to e do
       let indice = i.(level) in
        let element = Info.raw_extract indice t.(level) in
         Multi_hash.remove i element ;
         Info.replace element indice t.(level) ;
       done ;
     end ;
    M.remove i v ;
  end ;;

(** 
sub_tensor_remove level index tensor
*)

let sub_tensor_remove = fun (k:int) (i:index) (w:t) ->
 match w with
 | Vector v ->
  begin
   assert ( k = 0 ) ;
    V.remove i v
  end
 | Flat_tensor ( e , t , v ) ->
  begin
   let tk = t.(k)
   and f = fun y (( index , coefficient ):index array * coeff) ->
    begin
     if Index.eq i index.(k) then
      begin
       M.H.B.remove ( index , Coeff.zero () ) y ;
       for j = 0 to pred k do
        let jj = index.(j)
        and tj = t.(j) in
         let x = Info.raw_extract jj tj in
          Multi_hash.remove index x ;
          Info.replace x jj tj ;
       done ;
       for j = succ k to e do
        let jj = index.(j)
        and tj = t.(j) in
         let x = Info.raw_extract jj tj in
          Multi_hash.remove index x ;
          Info.replace x jj tj ;
       done ;
      end
    end
   and ( dim , table ) = v in
    let tki = Info.raw_extract i tk
    and s = Array.length table.M.H.data in
     let g = function (( index , coefficient ):index array * int) ->
      begin
       let u = table.M.H.data.( coefficient mod s ) in
        M.H.B.iter ( f u ) u ;
      end in
      Multi_hash.iter g tki ;
      Info.remove i tk ;
  end ;;

(** 
sub_tensor_replace sub_tensor level index tensor
*)

let sub_tensor_replace = fun (x:t) (k:int) (i:index) (w:t) ->
 match w with
 | Vector v ->
  begin
   assert ( k = 0 ) ;
   let e = V.elements ( vector_demakeup x ) in
    assert ( List.length e = 1 ) ;
    let y = snd ( List.hd e ) in
     V.replace y i v
  end
 | Flat_tensor ( e , t , v ) ->
  begin
   sub_tensor_remove k i w ;
   let f = function ( index , coefficient ) ->
    begin
     let new_index = Util.array_insert k i index in
      insert_add coefficient new_index w ;
      for j = 0 to e do
       let tj = t.(j)
       and indj = new_index.(j) in
        let xx = Info.raw_extract indj tj in
         Multi_hash.replace ( Multi_hasher.hash new_index ) new_index xx ;
         Info.replace xx indj tj ;
      done ;
    end in
    M.iter f ( flat_tensor_bare_demakeup ( flatten x ) )
  end ;;

(** 
iter function tensor
*)

let iter = fun (f:M.elt -> unit) (w:t) ->
 match w with
 | Vector v ->
  begin
   let ff = function ( i , x ) -> f ( [| i |] , x ) in
    V.iter ff v
  end
 | Flat_tensor ( e , t , v ) -> M.iter f v ;;

(** 
in_place_map function tensor
*)

let in_place_map = fun (f:coeff -> coeff) (w:t) ->
 match w with
 | Vector v -> V.in_place_map f v
 | Flat_tensor ( e , t , v ) -> M.in_place_map f v ;;

(** 
in_place_mapi function tensor
*)

let in_place_mapi = fun f (w:t) ->
 match w with
 | Vector v ->
  begin
   let g = fun i x -> f [| i |] x in
    V.in_place_mapi g v
  end
 | Flat_tensor ( e , t , v ) -> M.in_place_mapi f v ;;

(** 
raw_map function tensor
*)

let raw_map = fun (f:coeff -> coeff) (w:t) ->
 match w with
 | Vector v -> Vector ( V.map f v )
 | Flat_tensor ( e , t , v ) -> Flat_tensor ( e , Array.map Info.copy t , M.map f v ) ;;

(** 
map function tensor
*)

let map = fun (f:coeff -> coeff) (w:t) ->
 match w with
 | Vector v -> Vector ( V.map f v )
 | Flat_tensor ( e , t , v ) ->
  begin
   let result = Flat_tensor ( e , Array.map Info.copy t , M.map f v ) in
    info_update result ;
    result
  end ;;

(** 
mapi function tensor
*)

let mapi = fun f (w:t) ->
 match w with
 | Vector v ->
  begin
   let g = fun i x -> f [| i |] x in
    Vector ( V.mapi g v )
  end
 | Flat_tensor ( e , t , v ) ->
  begin
   let result = Flat_tensor ( e , Array.map Info.copy t , M.mapi f v ) in
    info_update result ;
    result
  end ;;

(** 
fold function tensor init
*)

let fold = fun (f:M.elt -> 'a -> 'a) (w:t) (init:'a) ->
 match w with
 | Vector v ->
  begin
   let ff = function ( i , x ) -> f ( [| i |] , x ) in
    V.fold ff v init
  end
 | Flat_tensor ( e , t , v ) -> M.fold f v init ;;

(** 
sub_flat_tensor index_array tensor
*)

let sub_flat_tensor = fun (i:index array) (w:t) ->
 match w with
 | Vector v -> failwith "Not a flat tensor in Sparse.Rng_tensor.sub_tensor."
 | Flat_tensor ( e , t , v ) ->
  begin
   let d = M.dimension v
   and shift = Array.length i in
    let complement = e - shift + 1
    and p = function j -> Util.array_eq Index.eq i ( Array.sub j 0 shift ) in
     if shift > e then
      failwith "Not a valid index array in Sparse.Rng_tensor.sub_tensor." ;
     let dd = Array.sub d shift complement in
      let result = null dd in
       let f = fun ( i , x ) -> if p (i) then insert_add x ( Array.sub i shift complement ) result in
        iter f w ;
        info_update result ;
        result
  end ;;

(** 
suffix_sub_flat_tensor index_array tensor
*)

let suffix_sub_flat_tensor = fun (i:index array) (w:t) ->
 match w with
 | Vector v -> failwith "Not a flat tensor in Sparse.Rng_tensor.suffix_sub_tensor."
 | Flat_tensor ( e , t , v ) ->
  begin
   let d = M.dimension v
   and complement = Array.length i in
    if complement > e then
      failwith "Not a valid index array in Sparse.Rng_tensor.suffix_sub_tensor." ;
    let shift = e - complement + 1 in
     let dd = Array.sub d 0 shift
     and p = function j -> Util.array_eq Index.eq i ( Array.sub j shift complement ) in
      let result = null dd in
       let f = fun ( i , x ) -> if p(i) then insert_add x ( Array.sub i 0 shift ) result in
        iter f w ;
        info_update result ;
        result
  end ;;

(** 
sub_vector_tensor index_array tensor
*)

let sub_vector_tensor = fun (i:index array) (w:t) ->
 match w with
 | Vector v -> failwith "Not a flat tensor in Sparse.Rng_tensor.sub_vector."
 | Flat_tensor ( e , t , v ) ->
  begin
   let d = M.dimension v
   and shift = Array.length i in
    if shift <> e then
     failwith "Not a valid index array in Sparse.Rng_tensor.sub_vector." ;
    let p = function j -> Util.array_eq Index.eq i ( Array.sub j 0 shift )
    and dd = Util.array_last d in
     let result = V.null dd in
      let f = fun ( i , x ) -> if p i then V.insert_add x ( Util.array_last i ) result in
       iter f w ;
       result
  end ;;

(** 
suffix_sub_vector_tensor index_array tensor
*)

let suffix_sub_vector_tensor = fun (i:index array) (w:t) ->
 match w with
 | Vector v -> failwith "Not a flat tensor in Sparse.Rng_tensor.suffix_sub_vector."
 | Flat_tensor ( e , t , v ) ->
  begin
   let d = M.dimension v
   and complement = Array.length i in
    if complement <> e then
     failwith "Not a valid index array in Sparse.Rng_tensor.suffix_sub_vector." ;
    let p = function j -> Util.array_eq Index.eq i ( Util.array_tail j )
    and dd = d.(0) in
     let result = V.null dd in
      let f = fun ( i , x ) -> if p i then V.insert_add x i.(0) result in
       iter f w ;
       result
  end ;;

(** 
embed dimensions shift tensor
*)

let embed = fun (dimensions:index array) (shift:index array) (w:t) ->
 match w with
 | Vector v ->
  begin
   assert ( ( Array.length dimensions = 1 ) && ( Array.length shift = 1 ) ) ;
   Vector ( V.embed dimensions.(0) shift.(0) v )
  end
 | Flat_tensor ( e , t , v ) ->
  begin
   let ee = succ e
   and tt = Array.map Info.zero ( Array.make ( succ e ) () ) in
    assert ( ( Array.length dimensions = ee ) && ( Array.length shift = ee ) ) ;
    let w = Flat_tensor ( e , tt , M.embed dimensions shift v ) in
     info_augment w ;
     w
  end ;;

(** 
min tensor
*)

let min = function (w:t) ->
 match w with
 | Vector v -> V.min v
 | Flat_tensor ( e , t , v ) -> M.min v ;;

(** 
max tensor
*)

let max = function (w:t) ->
 match w with
 | Vector v -> V.max v
 | Flat_tensor ( e , t , v ) -> M.max v ;;

(** 
in_place_opp tensor
*)

let in_place_opp = function (w:t) ->
 match w with
 | Vector v -> V.in_place_opp v
 | Flat_tensor ( e , t , v ) -> M.in_place_opp v ;;

(** 
opp tensor
*)

let opp = function (w:t) ->
 match w with
 | Vector v -> Vector ( V.opp v )
 | Flat_tensor ( e , t , v ) -> Flat_tensor ( e , Array.map Info.copy t , M.opp v ) ;;


(** 
in_place_add tensor1 tensor2
The first tensor stores the result.

Le premier tenseur accueille le résultat. *)


let in_place_add = fun (w:t) (x:t) ->
 let error_message = "Bad thickness in Sparse.Rng_tensor.in_place_add." in
  match w with
  | Vector u ->
   begin
    match x with
    | Vector y -> V.in_place_add u y
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      if ee <> 0 then
       failwith error_message ;
      V.in_place_add u ( vector_demakeup ( tensor_to_vector x ) )
     end
   end
  | Flat_tensor ( e , t , v ) ->
   begin
    match x with
    | Vector y ->
     begin
      if e <> 0 then
       failwith error_message ;
      M.in_place_add v ( flat_tensor_bare_demakeup ( flatten x ) )
     end
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      M.in_place_add v vv ;
      info_update w ;
     end
   end ;;

(** 
add tensor1 tensor2
*)

let rec add = fun (w:t) (x:t) ->
 let error_message = "Bad thickness in Sparse.Rng_tensor.add." in
  match w with
  | Vector u ->
   begin
    match x with
    | Vector y -> Vector ( V.add u y )
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      if ee <> 0 then
       failwith error_message ;
      Vector ( V.add u ( vector_demakeup ( tensor_to_vector x ) ) )
     end
   end
  | Flat_tensor ( e , t , v ) ->
   begin
    match x with
    | Vector y -> add x w
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      if e <> ee then
       failwith error_message ;
      let result = Flat_tensor ( e , Array.map Info.zero ( Array.make ( succ e ) () ) , M.add v vv ) in
       info_augment result ;
       result
     end
   end ;;

(** 
in_place_sub tensor1 tensor2
*)

let in_place_sub = fun (w:t) (x:t) ->
 let error_message = "Bad thickness in Sparse.Rng_tensor.in_place_sub." in
  match w with
  | Vector u ->
   begin
    match x with
    | Vector y -> V.in_place_sub u y
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      if ee <> 0 then failwith
       error_message ;
      V.in_place_sub u ( vector_demakeup ( tensor_to_vector x ) )
     end
   end
  | Flat_tensor ( e , t , v ) ->
   begin
    match x with
    | Vector y ->
     begin
      if e <> 0 then failwith
       error_message ;
      M.in_place_sub v ( flat_tensor_bare_demakeup ( flatten x ) ) ;
      info_update w ;
     end
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      M.in_place_sub v vv ;
      info_update w ;
     end
   end ;;

(** 
sub tensor1 tensor2
*)

let sub = fun (w:t) (x:t) ->
 let error_message = "Bad thickness in Sparse.Rng_tensor.sub." in
  match w with
  | Vector u ->
   begin
    match x with
    | Vector y -> Vector ( V.sub u y )
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      if ee <> 0 then
       failwith error_message ;
      Vector ( V.sub u ( vector_demakeup ( tensor_to_vector x ) ) )
     end
   end
  | Flat_tensor ( e , t , v ) ->
   begin
    match x with
    | Vector y ->
     begin
      if e <> 0 then
       failwith error_message ;
      Vector ( V.sub ( vector_demakeup ( tensor_to_vector w ) ) y )
     end
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      if e <> ee then
       failwith error_message ;
      let result = Flat_tensor ( e , Array.map Info.zero ( Array.make ( succ e ) () ) , M.sub v vv ) in
       info_augment result ;
       result 
     end
   end ;;


(** 
tensor_sample beginning ending tensor
All the multi-indices between the two ends in the lexicographic order are selected.

Tous les multi-indices entre les deux bornes dans l'ordre lexicographique sont sélectionnés. *)


let tensor_sample = fun (beginning:index array) (ending:index array) (w:t) ->
 match w with
 | Vector v -> Vector ( V.sub_vector beginning.(0) ending.(0) v )
 | Flat_tensor ( e , t , v ) ->
  begin
   let result = Flat_tensor ( e , Array.map Info.zero ( Array.make ( succ e ) () ) , M.sub_vector beginning ending v ) in
    info_augment result ;
    result 
  end ;;

(** 
sum tensor
*)

let sum = function (w:t) ->
 match w with
 | Vector v -> V.sum v
 | Flat_tensor ( e , t , v ) -> M.sum v ;;

(** 
contraction init tensor
*)

let contraction = fun (init:coeff) (w:t) ->
 match w with
 | Vector v -> V.contraction init v
 | Flat_tensor ( e , t , v ) -> M.contraction init v ;;

(** 
in_place_scal_add scalar tensor
*)

let in_place_scal_add = fun (scal:coeff) (w:t) ->
 match w with
 | Vector v -> V.in_place_scal_add scal v
 | Flat_tensor ( e , t , v ) ->
  begin
   M.in_place_scal_add scal v ;
   info_update w
  end ;;

(** 
scal_add scalar tensor
*)

let scal_add = fun (scal:coeff) (w:t) ->
 match w with
 | Vector v -> Vector ( V.scal_add scal v )
 | Flat_tensor ( e , t , v ) ->
  begin
   let result = Flat_tensor ( e , Array.map Info.zero ( Array.make ( succ e ) () ) , M.scal_add scal v ) in
    info_augment result ;
    result
  end ;;

(** 
in_place_scal_mult scalar tensor
*)

let in_place_scal_mult = fun (scal:coeff) (w:t) ->
 match w with
 | Vector v -> V.in_place_scal_mult scal v
 | Flat_tensor ( e , t , v ) ->
  begin
   M.in_place_scal_mult scal v ;
   info_update w
  end ;;

(** 
scal_mult scalar tensor
*)

let scal_mult = fun (scal:coeff) (w:t) ->
 match w with
 | Vector v -> Vector ( V.scal_mult scal v )
 | Flat_tensor ( e , t , v ) ->
  begin
   let result = Flat_tensor ( e , Array.map Info.zero ( Array.make ( succ e ) () ) , M.scal_mult scal v ) in
    info_augment result ;
    result
  end ;;

(** 
in_place_scal_right_sub scalar tensor
*)

let in_place_scal_right_sub = fun (scal:coeff) (w:t) ->
 match w with
 | Vector v -> V.in_place_scal_right_sub scal v
 | Flat_tensor ( e , t , v ) ->
  begin
   M.in_place_scal_right_sub scal v ;
   info_update w
  end ;;

(** 
scal_right_sub scalar tensor
*)

let scal_right_sub = fun (scal:coeff) (w:t) ->
 match w with
 | Vector v -> Vector ( V.scal_right_sub scal v )
 | Flat_tensor ( e , t , v ) ->
  begin
   let result = Flat_tensor ( e , Array.map Info.zero ( Array.make ( succ e ) () ) , M.scal_right_sub scal v ) in
    info_augment result ;
    result
  end ;;

(** 
in_place_scal_left_sub scalar tensor
*)

let in_place_scal_left_sub = fun (scal:coeff) (w:t) ->
 match w with
 | Vector v -> V.in_place_scal_left_sub scal v
 | Flat_tensor ( e , t , v ) ->
  begin
   M.in_place_scal_left_sub scal v ;
   info_update w
  end ;;

(** 
scal_left_sub scalar tensor
*)

let scal_left_sub = fun (scal:coeff) (w:t) ->
 match w with
 | Vector v -> Vector ( V.scal_left_sub scal v )
 | Flat_tensor ( e , t , v ) ->
  begin
   let result = Flat_tensor ( e , Array.map Info.zero ( Array.make ( succ e ) () ) , M.scal_left_sub scal v ) in
    info_augment result ;
    result
  end ;;

(** 
coeff_prod tensor1 tensor2
*)

let rec coeff_prod = fun (w:t) (x:t) ->
 let error_message = "Bad thickness in Sparse.Rng_tensor.coeff_prod." in
  match w with
  | Vector u ->
   begin
    match x with
    | Vector y -> Vector ( V.coeff_prod u y )
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      if ee <> 0 then
       failwith error_message ;
      Vector ( V.coeff_prod u ( vector_demakeup ( tensor_to_vector x ) ) )
     end
   end
  | Flat_tensor ( e , t , v ) ->
   begin
    match x with
    | Vector y -> coeff_prod x w
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      if e <> ee then failwith error_message ;
      let result = Flat_tensor ( e , Array.map Info.zero ( Array.make ( succ e ) () ) , M.coeff_prod v vv ) in
       info_augment result ;
       result
     end
   end ;;

(** 
scal_prod tensor1 tensor2
*)

let rec scal_prod = fun (w:t) (x:t) ->
 let error_message = "Bad thickness in Sparse.Rng_tensor.scal_prod." in
  match w with
  | Vector u ->
   begin
    match x with
    | Vector y -> V.scal_prod u y
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      if ee <> 0 then
       failwith error_message ;
      V.scal_prod u ( vector_demakeup ( tensor_to_vector x ) )
     end
   end
  | Flat_tensor ( e , t , v ) ->
   begin
    match x with
    | Vector y -> scal_prod x w
    | Flat_tensor ( ee , tt , vv ) ->
     begin
      if e <> ee then
       failwith error_message ;
      M.scal_prod v vv
     end
   end ;;

(** 
norm_1 tensor
*)

let norm_1 = function (w:t) ->
 match w with
 | Vector v -> V.norm_1 v
 | Flat_tensor ( e , t , v ) -> M.norm_1 v ;;

(** 
norm_inf tensor
*)

let norm_inf = function (w:t) ->
 match w with
 | Vector v -> V.norm_inf v
 | Flat_tensor ( e , t , v ) -> M.norm_inf v ;;

(** 
square_sum tensor
*)

let square_sum = function (w:t) ->
 match w with
 | Vector v -> V.square_sum v
 | Flat_tensor ( e , t , v ) -> M.square_sum v ;;

(** 
square_norm_2 tensor
*)

let square_norm_2 = function (w:t) ->
 match w with
 | Vector v -> V.square_norm_2 v
 | Flat_tensor ( e , t , v ) -> M.square_norm_2 v ;;

(** 
norm_compare norm tensor1 tensor2
*)

let norm_compare = fun n (w:t) (x:t) ->
 Coeff.norm_compare ( n w ) ( n x ) ;;

(** 
compare tensor1 tensor2
*)

let compare = fun (w:t) (x:t) ->
 norm_compare norm_1 w x ;;


(** 
exchange level index1 index2 tensor
This function is applied in place.

Cette fonction est appliquée en place. *)


let exchange = fun (level:int) (i:index) (j:index) (w:t) ->
 let error_message = "Bad level in Sparse.Rng_tensor.exchange." in
  match w with
  | Vector v ->
   begin
    if level <> 0 then
     failwith error_message ;
    if not ( Index.eq i j ) then
     V.exchange i j v ;
     V.cleanup v
   end
  | Flat_tensor ( e , t , v ) ->
   begin
    if level > e then
     failwith error_message ;
    if not ( Index.eq i j ) then
     begin
      let old_i = sub_tensor_extract level i w
      and old_j = sub_tensor_extract level j w in
       sub_tensor_replace old_i level j w ;
       sub_tensor_replace old_j level i w ;
     end
   end ;;


(** 
level_exchange level1 level2 tensor
This function is applied in place.

Cette fonction est appliquée en place. *)


let level_exchange = fun (i:int) (j:int) (w:t) ->
 let error_message = "Bad levels in Sparse.Rng_tensor.level_exchange." in
  match w with
  | Vector v ->
   begin
    if ( i <> 0 ) || ( j <> 0 ) then
     failwith error_message ;
   end
  | Flat_tensor ( e , t , v ) ->
   begin
    if ( i > e ) || ( j > e ) then
     failwith error_message ;
    if i <> j then
     begin
      let f = function ( k , x ) ->
       begin
        let accu = k.(i) in
         k.(i) <- k.(j) ;
         k.(j) <- accu ;
       end in
       M.iter f v ;
       let d = fst v in
        let accu = d.(i) in
         d.(i) <- d.(j) ;
         d.(j) <- accu ;
         cleanup w ;
     end
   end ;;

(** 
mult tensor1 tensor2
*)

let mult = fun (w:t) (ww:t) ->
 match w with
 | Vector v ->
  begin
   match ww with
   | Vector vv ->
    begin
     let d = [| V.dimension v ; V.dimension vv |] in
      let x = null d in
       let f = function ( index , coefficient ) -> sub_tensor_replace ( scal_mult coefficient ww ) 0 index x in
        V.iter f v ;
        x
    end
   | Flat_tensor ( ee , tt , vv ) ->
    begin
     let d = Array.append [| V.dimension v |] ( M.dimension vv ) in
      let x = null d in
       let f = function ( index , coefficient ) -> sub_tensor_replace ( scal_mult coefficient ww ) 0 index x in
        V.iter f v ;
        x
    end
  end
 | Flat_tensor ( e , t , v ) ->
  begin
   match ww with
   | Vector vv ->
    begin
     let d = Array.append ( M.dimension v ) [| V.dimension vv |] in
      let x = null d in
       let f = function ( index , coefficient ) -> sub_tensor_replace ( scal_mult coefficient w ) ( succ e ) index x in
        V.iter f vv ;
        x
    end
   | Flat_tensor ( ee , tt , vv ) ->
    begin
     let d = Array.append ( M.dimension v ) ( M.dimension vv ) in
      let x = null d in
       let f = function ( index , coefficient ) ->
        begin
         let g = function ( i , y ) -> insert_add ( Coeff.mult coefficient y ) ( Array.append index i ) x in
          M.iter g vv
        end in
        M.iter f v ;
        x
    end
  end ;;

(** 
safe_mult tensor1 tensor2
*)

let safe_mult = fun (w:t) (ww:t) ->
 mult ( copy w ) ( copy ww ) ;;








(**
§ § §
*)





end ;;




(**
§
*)

(**

Tenseurs creux à coefficients dans un corps commutatif

Sparse tensors with coefficients in a field

 *)

(**
*)





module Field (Index:Data.Index_type) (Hasher:Hash.Hash_type with type t = Index.t) (Coeff:Data.Field_coeff_type) = struct


include Rng (Index) (Hasher) (Coeff) ;;


module W = Sparse_vector.Field (Index) (Hasher) (Coeff) ;;


module N = Sparse_vector.Field (Multi_index) (Multi_hasher) (Coeff) ;;


(** 
in_place_inv tensor
This function is applied in place.

Cette fonction est appliquée en place. *)


let in_place_inv = function (w:t) ->
 match w with
 | Vector v -> W.in_place_inv v
 | Flat_tensor ( e , t , v ) -> N.in_place_inv v ;;

(** 
inv tensor
*)

let inv = function (w:t) ->
 match w with
 | Vector v -> Vector ( W.inv v )
 | Flat_tensor ( e , t , v ) -> Flat_tensor ( e , Array.map Info.copy t , N.inv v ) ;;

(** 
in_place_scal_right_div scalar tensor
This function is applied in place.

Cette fonction est appliquée en place. *)


let in_place_scal_right_div = fun (x:coeff) (w:t) ->
 match w with
 | Vector v -> W.in_place_scal_right_div x v
 | Flat_tensor ( e , t , v ) -> N.in_place_scal_right_div x v ;;

(** 
scal_right_div scalar tensor
*)

let scal_right_div = fun (x:coeff) (w:t) ->
 match w with
 | Vector v -> Vector ( W.scal_right_div x v )
 | Flat_tensor ( e , t , v ) -> Flat_tensor ( e , Array.map Info.copy t , N.scal_right_div x v ) ;;


(** 
in_place_scal_left_div scalar tensor
This function is applied in place.

Cette fonction est appliquée en place. *)


let in_place_scal_left_div = fun (x:coeff) (w:t) ->
 match w with
 | Vector v -> W.in_place_scal_left_div x v
 | Flat_tensor ( e , t , v ) -> N.in_place_scal_left_div x v ;;

(** 
scal_left_div scalar tensor
*)

let scal_left_div = fun (x:coeff) (w:t) ->
 match w with
 | Vector v -> Vector ( W.scal_left_div x v )
 | Flat_tensor ( e , t , v ) -> Flat_tensor ( e , Array.map Info.copy t , N.scal_left_div x v ) ;;









(**
§ § §
*)





end ;;








(**
§ § §
*)





end ;;









module Sparse_matrix = struct



(**
§
*)

(**

Introduction

 *)

(**
*)




(** The mathematician will find in this module functors to handle sparse matrices with coefficients in a commutative rng or a field.

Conventions

Dimensions are often unreachable in a sparse tensor as soon as it is null (excepted sometimes for the first variable). Since sparse matrices are modelled on sparse tensors, the problem is present too for null sparse amtrices, and a null sparse matrix is sometimes supposed to be square.

Comments

A function is sealed if there is no sharing between the input variables and the output value. This is the expected behavior of usual mathematical functions. The recursive programming of polymorphic functions is easier in a non sealed way. Some copy functions are provided for every type of data. They are sealed provided that they receive as argument elementary copy functions for coefficients and indices. By composition, they permit to seal all functions necessary.

This module is distributed under the same licence as Ocaml.

§

La mathématicienne ou le mathématicien trouvera dans ce module des focnteurs pour traiter les matrices creuses à coefficients dans un annau commutatif ou un corps.

Conventions

Les dimensions d'un tenseur creux sont souvent inaccessibles (sauf parfois pour la première variable) dès qu'il est nul. Puisque les matrices creuses sont modelées sur les tenseurs creux, le problème se pose aussi pour les matrices creuses nulles, et une matrice creuse nulle est parfois supposée carrée.

Commentaires

Une fonction est étanche quand il n'y a aucun partage entre les variables fournies en entrée et la valeur obtenue en sortie. C'est le comportement attendu des fonctions mathématiques habituelles. La programmation récursive des fonctions polymorphes est plus facile de manière non étanche. Des fonctions de recopie sont fournies pour tous les types de données. Elles sont étanches à condition de leur fournir en argument des fonctions élémentaires de recopie des coefficients et des indices. Par composition, elle permettent d'étanchéifier toutes les fonctions voulues.

Ce module est distribué selon la même licence qu'Ocaml.

Copyright Stéphane Grognet
Laboratoire de mathématiques Jean Leray UMR 6629 CNRS
Fédération de recherche mathématique des Pays de la Loire
Centre Henri Lebesgue
IREM des Pays de la Loire - Université de Nantes
version 0.1
*)

(** @version 0.1 *)

(** @author Stéphane Grognet *)

(** @since 2013 *)





(**
§
*)

(**

Matrices creuses à coefficients dans un annau commutatif

Sparse matrices with coefficients in a commiutative Rng

 *)

(**
*)





open Util ;;
open Data ;;
open Hash ;;
open Sparse_vector ;;
open Sparse_tensor ;;



module Rng (Index:Data.Index_type) (Hasher:Hash.Hash_type with type t = Index.t) (Coeff:Data.Rng_coeff_type) = struct



type index = Index.t ;;

type coeff = Coeff.t ;;

type elt = index * coeff ;;



module V = Sparse_vector.Rng (Index) (Hasher) (Coeff) ;;



module T = Sparse_tensor.Rng (Index) (Hasher) (Coeff) ;;



(** A very sparse matrix is profitably represented as a sparse tensor. The matrices who are little different from a scalar or multi-scalar matrix are also included in the type. In all the preceding cases, the indices may be naturally polymorphic. In all the following cases, the indices are generally of type int. The invertible sparse matrices are handled preferably as full vectors whose coefficients are sparse vectors. The matrices who differ a little from a diagonal or multi-diagonal matrix are also included in the type. The non square matrices of type Diff* are supposed to have more columns than rows. The lengths of the lines of coefficients on their own in Diff_to_diag_matrix and Diff_to_multi_diag_matrix may be greater than the dimensions of the associated sparse tensor.

BEWARE : In the Diff_to_multi_diag type, somme marginal coefficients of the multidiagonal are not taken into account : the second index of the multidiagonal is always (up to Index.from_int translation) the row number of the matrix.

Une matrice très creuse sera représentée avantageusement comme un tenseur creux. Les matrices qui diffèrent peu d'un matrice scalaire ou multi-scalaire sont aussi incluses dans le type. Dans tous les cas précédents, les indices peuvent être naturellement polymorphes. Dans les cas qui suivent, les indices sont généralement de type int. Les matrices creuses inversibles sont manipulées de préférence comme des vecteurs pleins dont les coefficients sont des vecteurs creux. Les matrices qui diffèrent peu d'une matrice diagonale ou multidiagonale sont aussi incluses dans le type. Les matrics non carrées de type Diff* sont censées avoir plus de colonnes que de lignes. La longueur des lignes de coefficients mis à part dans Diff_to_diag_matrix et Diff_to_multi_diag_matrix peuvent être supérieures aux dimensions du tenseur creux associé.

ATTENTION : Dans le type Diff_to_multi_diag, certains coefficients marginaux de la multidiagonale ne sont pas pris en compte : le second indice de la multidiagonale est toujours le numéro de ligne de la matrice (à traduction Index.from_int près). *)


type t = 
 | Sparse_tensor_matrix of T.t
 | Diff_to_scal_matrix of coeff * T.t
 | Diff_to_multi_scal_matrix of coeff array * T.t
 | Half_full_matrix of V.t array
 | Diff_to_diag_matrix of coeff array * T.t
 | Diff_to_multi_diag_matrix of coeff array array * T.t ;;

(** 
copy matrix
*)

let copy = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( T.copy w )
 | Diff_to_scal_matrix ( x , w ) -> Diff_to_scal_matrix ( Coeff.copy x , T.copy w )
 | Diff_to_multi_scal_matrix ( a , w ) -> Diff_to_multi_scal_matrix ( Array.map Coeff.copy a , T.copy w )
 | Half_full_matrix w -> Half_full_matrix ( Array.map ( V.copy ) w )
 | Diff_to_diag_matrix ( a , w ) -> Diff_to_diag_matrix ( Array.map Coeff.copy a , T.copy w )
 | Diff_to_multi_diag_matrix ( a , w ) -> Diff_to_multi_diag_matrix ( Array.map ( Array.map Coeff.copy ) a , T.copy w ) ;;




(**
§
*)

(**

Déstructurations

 *)

(**
*)





(** 
sparse_tensor_matrix_demakeup matrix
*)

let sparse_tensor_matrix_demakeup = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> w
 | _ -> failwith "Not a sparse tensor matrix in Sparse_matrix.Rng.sparse_tensor_matrix_demakeup." ;;

(** 
diff_to_scal_matrix_demakeup matrix
*)

let diff_to_scal_matrix_demakeup = function (m:t) ->
 match m with
 | Diff_to_scal_matrix ( x , w ) -> ( x , w )
 | _ -> failwith "Not a difference to scalar matrix in Sparse_matrix.Rng.diff_to_scal_matrix_demakeup." ;;

(** 
diff_to_multi_scal_matrix_demakeup matrix
*)

let diff_to_multi_scal_matrix_demakeup = function (m:t) ->
 match m with
 | Diff_to_multi_scal_matrix ( a , w ) -> ( a , w )
 | _ -> failwith "Not a difference to multi-scalar matrix in Sparse_matrix.Rng.diff_to_multi_scal_matrix_demakeup." ;;

(** 
half_full_matrix_demakeup matrix
*)

let half_full_matrix_demakeup = function (m:t) ->
 match m with
 | Half_full_matrix w -> w
 | _ -> failwith "Not a half full matrix in Sparse_matrix.Rng.half_full_matrix_demakeup." ;;

(** 
diff_to_diag_matrix_demakeup matrix
*)

let diff_to_diag_matrix_demakeup = function (m:t) ->
 match m with
 | Diff_to_diag_matrix ( a , w ) -> ( a , w )
 | _ -> failwith "Not a difference to diagonal matrix in Sparse_matrix.Rng.diff_to_diag_matrix_demakeup." ;;

(** 
diff_to_multi_diag_matrix_demakeup matrix
*)

let diff_to_multi_diag_matrix_demakeup = function (m:t) ->
 match m with
 | Diff_to_multi_diag_matrix ( a , w ) -> ( a , w )
 | _ -> failwith "Not a difference to multi-diagonal matrix in Sparse_matrix.Rng.diff_to_multi_diag_matrix_demakeup." ;;




(**
§
*)

(**

Opérations élémentaires

Elementary operations

 *)

(**
*)





(** 
null dimensions
*)

let null = fun (dimensions:'b array)  ->
 if Array.length dimensions <> 2 then failwith "Bad number of dimensions in Sparse_matrix.Rng.null." ;
 Sparse_tensor_matrix ( T.null dimensions ) ;;

(** 
zero unit
*)

let zero = fun () ->
 Sparse_tensor_matrix ( T.zero () ) ;;

(** 
filling matrix
*)

let filling = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> T.filling w
 | Diff_to_scal_matrix ( x , w ) -> T.filling w
 | Diff_to_multi_scal_matrix ( a , w ) -> T.filling w
 | Half_full_matrix w ->
  begin
   let a = Array.map V.filling w in
    Array.fold_left ( + ) 0 a
  end
 | Diff_to_diag_matrix ( a , w ) -> T.filling w
 | Diff_to_multi_diag_matrix ( a , w ) -> T.filling w ;;

(** 
detailed_filling matrix
*)

let detailed_filling = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> [| 0 ; T.filling w |]
 | Diff_to_scal_matrix ( x , w ) -> [| 1 ; T.filling w |]
 | Diff_to_multi_scal_matrix ( a , w ) -> [| Array.length a ; T.filling w |]
 | Half_full_matrix w -> [| 0 ; filling m |]
 | Diff_to_diag_matrix ( a , w ) -> [| Array.length a ; T.filling w |]
 | Diff_to_multi_diag_matrix ( a , w ) -> [| ( Array.length a ) * ( Array.length a.(0) ) ; T.filling w |] ;;

(** 
sizes matrix
*)

let sizes = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> T.sizes w
 | Diff_to_scal_matrix ( x , w ) -> T.sizes w
 | Diff_to_multi_scal_matrix ( a , w ) -> T.sizes w
 | Half_full_matrix w -> ( max_int , Array.map V.size w )
 | Diff_to_diag_matrix ( a , w ) -> T.sizes w
 | Diff_to_multi_diag_matrix ( a , w ) -> T.sizes w ;;

(** 
size matrix
*)

let size = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> T.size w
 | Diff_to_scal_matrix ( x , w ) -> T.size w
 | Diff_to_multi_scal_matrix ( a , w ) -> T.size w
 | Half_full_matrix w -> Array.fold_left ( + ) 0 ( Array.map V.size w )
 | Diff_to_diag_matrix ( a , w ) -> T.size w
 | Diff_to_multi_diag_matrix ( a , w ) -> T.size w ;;

(** 
dimensions matrix
*)

let dimensions = function (m:t) ->
 let d = 
  begin
   match m with
   | Sparse_tensor_matrix w -> T.dimensions w
   | Diff_to_scal_matrix ( x , w ) -> T.dimensions w
   | Diff_to_multi_scal_matrix ( a , w ) -> T.dimensions w
   | Half_full_matrix w ->
    begin
     let c = V.dimension w.(0)
     and r = Array.length w in
      [| Index.from_int r ; c |]
    end
   | Diff_to_diag_matrix ( a , w ) -> T.dimensions w
   | Diff_to_multi_diag_matrix ( a , w ) -> T.dimensions w 
  end in
  if ( Array.length d ) = 1 then Array.make 2 d.(0) else d ;;

(** 
cleanup matrix
*)

let cleanup = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> T.cleanup w
 | Diff_to_scal_matrix ( x , w ) -> T.cleanup w
 | Diff_to_multi_scal_matrix ( a , w ) -> T.cleanup w
 | Half_full_matrix w -> ignore ( Array.map V.cleanup w )
 | Diff_to_diag_matrix ( a , w ) -> T.cleanup w
 | Diff_to_multi_diag_matrix ( a , w ) -> T.cleanup w ;;

(** 
resize size matrix
*)

let resize = fun (n:int) (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> T.resize n w
 | Diff_to_scal_matrix ( x , w ) -> T.resize n w
 | Diff_to_multi_scal_matrix ( a , w ) -> T.resize n w
 | Half_full_matrix w -> ignore ( Array.map ( V.resize n ) w )
 | Diff_to_diag_matrix ( a , w ) -> T.resize n w
 | Diff_to_multi_diag_matrix ( a , w ) -> T.resize n w ;;

(** 
to_string matrix
*)

let to_string = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> "Sparse_tensor_matrix " ^ ( T.to_string w )
 | Diff_to_scal_matrix ( x , w ) -> "Diff_to_scal_matrix " ^ ( Coeff.to_string x ) ^ " $ " ^ ( T.to_string w )
 | Diff_to_multi_scal_matrix ( a , w ) -> "Diff_to_multi_scal_matrix " ^ ( Util.bare_vector_to_string Coeff.to_string a ) ^ " $ " ^ ( T.to_string w )
 | Half_full_matrix w -> "Half_full_matrix " ^ ( Util.vector_to_string ( V.to_string ) "{|" "~" "|}" w )
 | Diff_to_diag_matrix ( a , w ) -> "Diff_to_diag_matrix " ^ ( Util.bare_vector_to_string Coeff.to_string a ) ^ " $ " ^ ( T.to_string w )
 | Diff_to_multi_diag_matrix ( a , w ) -> "Diff_to_multi_diag_matrix " ^ ( Util.vector_to_string ( Util.bare_vector_to_string Coeff.to_string ) "{|" "~" "|}" a ) ^ " $ " ^ ( T.to_string w ) ;;

(** 
sparse_tensor_matrix_of_string string
*)

let sparse_tensor_matrix_of_string = function (s:string) ->
 let b = String.sub s 0 21 in
  if String.compare b "Sparse_tensor_matrix " = 0 then
   begin
    let t = String.sub s 21 ( ( String.length s ) - 21 ) in
     Sparse_tensor_matrix ( T.of_string t )
   end
  else
   failwith "Not a sparse tensor matrix in Sparse_matrix.Rng.sparse_tensor_matrix_of_string." ;;

(** 
half_full_matrix_of_string string
*)

let half_full_matrix_of_string = function (s:string) ->
 let b = String.sub s 0 17 in
  if String.compare b "Half_full_matrix " = 0 then
   begin
    let t = String.sub s 17 ( ( String.length s ) - 17 ) in
     Half_full_matrix ( Util.vector_of_string ( V.of_string ) "{|" "~" "|}" t )
   end
  else
   failwith "Not a half full matrix in Sparse_matrix.Rng.half_full_matrix_of_string." ;;

(** 
diff_to_scal_matrix_of_string string
*)

let diff_to_scal_matrix_of_string = function (s:string) ->
 let b = String.sub s 0 20 in
  if String.compare b "Diff_to_scal_matrix " = 0 then
   begin
    let t = String.sub s 20 ( ( String.length s ) - 20 ) in
     let listing = Str.split ( Str.regexp_string " $ " ) t in
      let u = List.hd listing
      and v = List.hd ( List.tl listing ) in
       Diff_to_scal_matrix ( Coeff.of_string u , T.of_string v )
   end
  else
   failwith "Not a difference-to-scalar matrix in Sparse_matrix.Rng.diff_to_scal_matrix_of_string." ;;

(** 
diff_to_multi_scal_matrix_of_string string
*)

let diff_to_multi_scal_matrix_of_string = function (s:string) ->
 let b = String.sub s 0 26 in
  if String.compare b "Diff_to_multi_scal_matrix " = 0 then
   begin
    let t = String.sub s 26 ( ( String.length s ) - 26 ) in
     let listing = Str.split ( Str.regexp_string " $ " ) t in
      let u = List.hd listing
      and v = List.hd ( List.tl listing ) in
       Diff_to_multi_scal_matrix ( Util.bare_vector_of_string Coeff.of_string u , T.of_string v )
   end
  else
   failwith "Not a difference-to-multi-scalar matrix in Sparse_matrix.Rng.diff_to_multi_scal_matrix_of_string." ;;

(** 
diff_to_diag_matrix_of_string string
*)

let diff_to_diag_matrix_of_string = function (s:string) ->
 let b = String.sub s 0 20 in
  if String.compare b "Diff_to_diag_matrix " = 0 then
   begin
    let t = String.sub s 20 ( ( String.length s ) - 20 ) in
     let listing = Str.split ( Str.regexp_string " $ " ) t in
      let u = List.hd listing
      and v = List.hd ( List.tl listing ) in
       Diff_to_diag_matrix ( Util.bare_vector_of_string Coeff.of_string u , T.of_string v )
   end
  else
   failwith "Not a difference-to-diagonal matrix in Sparse_matrix.Rng.diff_to_diag_matrix_of_string." ;;

(** 
diff_to_multi_diag_matrix_of_string string
*)

let diff_to_multi_diag_matrix_of_string = function (s:string) ->
 let b = String.sub s 0 26 in
  if String.compare b "Diff_to_multi_diag_matrix " = 0 then
   begin
    let t = String.sub s 26 ( ( String.length s ) - 26 ) in
     let listing = Str.split ( Str.regexp_string " $ " ) t in
      let u = List.hd listing
      and v = List.hd ( List.tl listing ) in
       let uu = Util.vector_of_string ( Util.bare_vector_of_string Coeff.of_string ) "{|" "~" "|}" u in
        Diff_to_multi_diag_matrix ( uu , T.of_string v )
   end
  else
   failwith "Not a difference-to-multi-diagonal matrix in Sparse_matrix.Rng.diff_to_multi_diag_matrix_of_string." ;;

(** 
of_string string
*)

let of_string = function (s:string) ->
 try
  sparse_tensor_matrix_of_string s
 with _ ->
  begin
   try
    half_full_matrix_of_string s
   with _ ->
    begin
     try
      diff_to_scal_matrix_of_string s
     with _ ->
      begin
       try
        diff_to_multi_scal_matrix_of_string s
       with _ ->
        begin
         try
          diff_to_diag_matrix_of_string s
         with _ ->
          begin
           try
            diff_to_multi_diag_matrix_of_string s
           with _ ->
            failwith "Not a valid string in Sparse_matrix.Rng.of_string."
          end
        end
      end
    end
  end ;;

(** 
print matrix
*)

let print = function (m:t) ->
 print_string ( to_string m ) ;
 print_newline () ;;


(** 
description_eq_zero matrix
This verification of nullity is superficial.

Cette vérification de nullité est superficielle. *)


let description_eq_zero = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w  -> T.eq_zero w
 | Diff_to_scal_matrix ( x , w ) -> ( Coeff.eq_zero x ) && ( T.eq_zero w )
 | Diff_to_multi_scal_matrix ( a , w ) -> ( Util.array_eq_zero Coeff.eq_zero a ) && ( T.eq_zero w )
 | Half_full_matrix w -> Util.array_eq_zero V.eq_zero w
 | Diff_to_diag_matrix ( a , w ) -> ( Util.array_eq_zero Coeff.eq_zero a ) && ( T.eq_zero w )
 | Diff_to_multi_diag_matrix ( a , w ) -> ( Util.array_eq_zero ( Util.array_eq_zero Coeff.eq_zero ) a ) && ( T.eq_zero w ) ;;


(** 
description_eq matrix1 matrix2
This verification of equality is superficial.

Cette vérification de nullité est superficielle. *)


let rec description_eq = fun (m:t) (n:t) ->
 match ( m , n ) with
 | ( Sparse_tensor_matrix w , Sparse_tensor_matrix ww ) -> T.eq w ww
 | ( Diff_to_scal_matrix ( x , w ) , Diff_to_scal_matrix ( xx , ww ) ) -> ( Coeff.eq x xx ) && ( T.eq w ww )
 | ( Diff_to_multi_scal_matrix ( a , w ) , Diff_to_multi_scal_matrix ( aa , ww ) ) ->
  begin
   let accu = ref ( T.eq w ww )
   and r = Array.length a
   and rr = Array.length aa in
    if !accu then
     begin
      if r <> rr then
       false
      else
       begin
        let i = ref 0 in
         while !i < r do
          accu := Coeff.eq a.(!i) aa.(!i) ;
          if !accu then
           incr i
          else
           i := r ;
         done ;
         !accu
       end
     end
    else
     !accu
  end
 | ( Half_full_matrix w , Half_full_matrix ww ) ->
  begin
   let r = Array.length w
   and rr = Array.length ww in
    let accu = ref ( r = rr ) in
     if !accu then
      begin
       let i = ref 0 in
        while !i < r do
         accu := V.eq w.(!i) ww.(!i) ;
         if !accu then
          incr i
         else i := r
        done ;
        !accu
      end
     else
      false
  end
 | ( Diff_to_diag_matrix ( a , w ) , Diff_to_diag_matrix ( aa , ww ) ) -> description_eq ( Diff_to_multi_scal_matrix ( a , w ) ) ( Diff_to_multi_scal_matrix ( aa , ww ) )
 | ( Diff_to_multi_diag_matrix ( a , w ) , Diff_to_multi_diag_matrix ( aa , ww ) )->
  begin
   let accu = ref ( T.eq w ww )
   and r = Array.length a
   and rr = Array.length aa
   and c = Array.length a.(0)
   and cc = Array.length aa.(0) in
    if !accu then
     begin
      if ( r <> rr ) || ( c <> cc )then
       false
      else
       begin
        let i = ref 0 in
         while !i < r do
          accu := Util.array_eq Coeff.eq a.(!i) aa.(!i) ;
          if !accu then
           incr i
          else
           i := r ;
         done ;
         !accu
       end
     end
    else
     !accu
  end
 | _ -> failwith "Incompatible formats in Sparse_matrix.Rng.sparse_matrix_eq." ;;

(** 
tensor_row_extract index tensor
*)

let tensor_row_extract = fun (i:index) (w:T.t) ->
 T.vector_demakeup ( T.tensor_to_vector ( T.sub_tensor_extract 0 i w ) ) ;;

(** 
tensor_column_extract index tensor
*)

let tensor_column_extract = fun (i:index) (w:T.t) ->
  T.vector_demakeup ( T.tensor_to_vector ( T.sub_tensor_extract 1 i w ) ) ;;

(** 
row_extract index matrix
*)

let row_extract = fun (i:index) (m:t) ->
 match m with
 | Half_full_matrix w -> w.( Index.to_int i )
 | Sparse_tensor_matrix w  -> tensor_row_extract i w
 | Diff_to_scal_matrix ( x , w ) ->
  begin
   let v = tensor_row_extract i w in
    V.insert_add x i v ;
    v
  end
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   let v = tensor_row_extract i w
   and ii = Index.to_int i
   and h_a_l = ( Array.length a ) / 2 in
    let cc = pred ( Index.to_int ( V.dimension v ) )
    and shift = ii - h_a_l in
     for j = max 0 shift to min cc ( ii + h_a_l ) do
      V.insert_add a.( j - shift ) ( Index.from_int j ) v ;
     done ;
    v
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let v = tensor_row_extract i w in
    V.insert_add a.( Index.to_int i ) i v ;
    v
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let v = tensor_row_extract i w
   and ii = Index.to_int i
   and h_a_l = ( Array.length a ) / 2 in
    let cc = pred ( Index.to_int ( V.dimension v ) )
    and shift = ii - h_a_l in
     for j = max 0 shift to min cc ( ii + h_a_l ) do
      V.insert_add a.( j - shift ).( Index.to_int i ) ( Index.from_int j ) v ;
     done ;
    v
  end ;;

(** 
column_extract index matrix
*)

let column_extract = fun (i:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let r = Array.length w in
    let d = Index.from_int r in
     let v = V.null d in
      for j = 0 to pred r do
       try
        begin
         let ( ii , x ) = V.unsafe_extract i w.(j) in
          V.insert_add x ( Index.from_int j ) v
        end
       with _ ->
        ()
      done ;
      v
  end
 | Sparse_tensor_matrix w  -> tensor_column_extract i w
 | Diff_to_scal_matrix ( x , w ) ->
  begin
   let v = tensor_column_extract i w in
    V.insert_add x i v ;
    v
  end
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   let v = tensor_column_extract i w
   and ii = Index.to_int i
   and h_a_l = ( Array.length a ) / 2 in
    let rr = pred ( Index.to_int ( V.dimension v ) )
    and shift = ii - h_a_l
    and bound = ii + h_a_l in
     for j = max 0 shift to min rr bound do
      V.insert_add a.( bound - j ) ( Index.from_int j ) v ;
     done ;
    v
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let v = tensor_column_extract i w in
    V.insert_add a.( Index.to_int i ) i v ;
    v
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let v = tensor_column_extract i w
   and ii = Index.to_int i
   and h_a_l = ( Array.length a ) / 2 in
    let rr = pred ( Index.to_int ( V.dimension v ) )
    and shift = ii - h_a_l
    and bound = ii + h_a_l in
     for j = max 0 shift to min rr bound do
      V.insert_add a.( bound - j ).(j) ( Index.from_int j ) v ;
     done ;
    v
  end ;;

(** 
extract row column matrix
*)

let extract = fun (i:index) (j:index) (m:t) ->
 match m with
 | Half_full_matrix w -> snd ( V.extract j w.( Index.to_int i ) )
 | Sparse_tensor_matrix w -> snd ( T.extract [| i ; j |] w )
 | Diff_to_scal_matrix ( y , w ) ->
  begin
   let x = snd ( T.extract [| i ; j |] w ) in
    if Index.eq i j then
     Coeff.add y x
    else
     x
  end
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   let x = snd ( T.extract [| i ; j |] w )
   and h_a_l = ( Array.length a ) / 2
   and diff = Index.to_int ( Index.sub i j ) in
    if abs diff <= h_a_l then
     Coeff.add a.( h_a_l + diff ) x
    else
     x
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let x = snd ( T.extract [| i ; j |] w ) in
    if Index.eq i j then
     Coeff.add a.( Index.to_int i ) x
    else
     x
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let x = snd ( T.extract [| i ; j |] w )
   and h_a_l = ( Array.length a ) / 2
   and diff = Index.to_int ( Index.sub i j ) in
    if abs diff <= h_a_l then
     Coeff.add a.( h_a_l + diff ).( Index.to_int i ) x
    else
     x
  end ;;

(** 
tensor_row_remove index tensor
*)

let tensor_row_remove = fun (i:index) (w:T.t) ->
 T.sub_tensor_remove 0 i w ;;

(** 
tensor_column_remove index tensor
*)

let tensor_column_remove = fun (i:index) (w:T.t) ->
 T.sub_tensor_remove 1 i w ;;

(** 
row_remove index matrix
*)

let row_remove = fun (i:index) (m:t) ->
 match m with
 | Half_full_matrix w -> w.( Index.to_int i ) <- V.zero ()
 | Sparse_tensor_matrix w -> tensor_row_remove i w
 | Diff_to_scal_matrix ( y , w ) ->
  begin
   tensor_row_remove i w ;
   try
    T.insert_add ( Coeff.opp y ) [| i ; i |] w
   with _ ->
    ()
  end
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   tensor_row_remove i w ;
   let d = T.dimensions w
   and ii = Index.to_int i
   and h_a_l = ( Array.length a ) / 2 in
    let cc = pred ( Index.to_int d.(1) )
    and shift = ii - h_a_l in
     for j = max 0 shift to min ( ii + h_a_l ) cc do
      let jj = Index.from_int j in
       T.replace ( Coeff.opp a.( j - shift ) ) [| i ; jj |] w ;
     done ;
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   tensor_row_remove i w ;
   try
    a.( Index.to_int i ) <- Coeff.zero ()
   with _ ->
    ()
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   tensor_row_remove i w ;
   let d = T.dimensions w
   and ii = Index.to_int i
   and h_a_l = ( Array.length a ) / 2 in
    let cc = pred ( Index.to_int d.(1) )
    and shift = ii - h_a_l in
     for j = max 0 shift to min ( ii + h_a_l ) cc do
      let jj = Index.from_int j in
       T.replace ( Coeff.opp a.( j - shift ).(ii) ) [| i ; jj |] w ;
     done ;
  end ;;

(** 
column_remove index matrix
*)

let column_remove = fun (i:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   for j = 0 to pred ( Array.length w ) do
    V.remove i w.(j)
   done
  end
 | Sparse_tensor_matrix w -> tensor_column_remove i w
 | Diff_to_scal_matrix ( y , w ) ->
  begin
   tensor_column_remove i w ;
   try
    T.insert_add ( Coeff.opp y ) [| i ; i |] w
   with _ ->
    ()
  end
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   tensor_column_remove i w ;
   let h_a_l = ( Array.length a ) / 2
   and d = T.dimensions w
   and ii = Index.to_int i in
    let cc = pred ( Index.to_int d.(1) )
    and shift = ii - h_a_l
    and bound = ii + h_a_l in
     for j = max 0 shift to min bound cc do
      let jj = Index.from_int j in
       T.replace ( Coeff.opp a.( bound - j ) ) [| i ; jj |] w ;
     done ;
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   tensor_column_remove i w ;
   try
    a.( Index.to_int i ) <- Coeff.zero () ;
   with _ ->
    ()
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   tensor_column_remove i w ;
   let h_a_l = ( Array.length a ) / 2
   and d = T.dimensions w
   and ii = Index.to_int i in
    let cc = pred ( Index.to_int d.(1) )
    and shift = ii - h_a_l
    and bound = ii + h_a_l in
     for j = max 0 shift to min bound cc do
      let jj = Index.from_int j
      and row_index = bound - j in
       T.replace ( Coeff.opp a.(row_index).(j) ) [| jj ; i |] w ;
     done ;
  end ;;

(** 
remove row column matrix
*)

let remove = fun (i:index) (j:index) (m:t) ->
 match m with
 | Half_full_matrix w -> V.remove j w.( Index.to_int i )
 | Sparse_tensor_matrix w -> T.remove [| i ; j |] w
 | Diff_to_scal_matrix ( y , w ) ->
  begin
   if Index.eq i j then
    T.replace ( Coeff.opp y ) ( Array.make 2 i ) w
   else
    T.remove [| i ; j |] w ;
  end
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   let h_a_l = ( Array.length a ) / 2
   and diff = Index.to_int ( Index.sub i j ) in
    if abs diff <= h_a_l then
     T.replace ( Coeff.opp a.( h_a_l + diff ) ) [| i ; j |] w
    else
     T.remove [| i ; j |] w ;
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   T.remove [| i ; j |] w ;
   if Index.eq i j then
    a.( Index.to_int i ) <- Coeff.zero () ;
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   T.remove [| i ; j |] w ;
   let h_a_l = ( Array.length a ) / 2
   and diff = Index.to_int ( Index.sub i j ) in
    if abs diff <= h_a_l then
     try
      a.( h_a_l + diff ).( Index.to_int i ) <- Coeff.zero () ;
     with _ ->
      ()
  end ;;

(** 
tensor_row_replace vector index matrix
*)

let tensor_row_replace = fun (x:V.t) (i:index) (w:T.t) ->
 T.sub_tensor_replace ( T.Vector x ) 0 i w ;;

(** 
tensor_column_replace vector index matrix
*)

let tensor_column_replace = fun (x:V.t) (i:index) (w:T.t) ->
 T.sub_tensor_replace ( T.Vector x ) 1 i w ;;


(** 
raw_row_replace vector index matrix
For the types storing diagonal values on their own, these ones are not taken into account in the operation. This function is applied in place.

Cette fonction est exécutée en place. Dans les types stockant des valeurs diagonales à part, celles-ci n'entrent pas en compte dans l'opération. *)


let raw_row_replace = fun (x:V.t) (i:index) (m:t) ->
 match m with
 | Half_full_matrix w -> w.( Index.to_int i ) <- x
 | Sparse_tensor_matrix w -> tensor_row_replace x i w
 | Diff_to_scal_matrix ( y , w ) -> tensor_row_replace x i w
 | Diff_to_multi_scal_matrix ( y , w ) -> tensor_row_replace x i w
 | Diff_to_diag_matrix ( a , w ) -> tensor_row_replace x i w
 | Diff_to_multi_diag_matrix ( a , w ) -> tensor_row_replace x i w ;;


(** 
raw_column_replace vector index matrix
For the types storing diagonal values on their own, these ones are not taken into account in the operation. This function is applied in place.

Cette fonction est exécutée en place. Dans les types stockant des valeurs diagonales à part, celles-ci n'entrent pas en compte dans l'opération. *)


let raw_column_replace = fun (x:V.t) (i:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let f = function ( j , y ) -> V.replace y i w.( Index.to_int j ) in
    V.iter f x
  end
 | Sparse_tensor_matrix w -> tensor_column_replace x i w
 | Diff_to_scal_matrix ( y , w ) -> tensor_column_replace x i w
 | Diff_to_multi_scal_matrix ( y , w ) -> tensor_column_replace x i w
 | Diff_to_diag_matrix ( a , w ) -> tensor_column_replace x i w
 | Diff_to_multi_diag_matrix ( a , w ) -> tensor_column_replace x i w ;;


(** 
row_replace vector index matrix
This function is applied in place.

Cette fonction est exécutée en place. *)


let row_replace = fun (x:V.t) (i:index) (m:t) ->
 match m with
 | Half_full_matrix w -> w.( Index.to_int i ) <- x
 | Sparse_tensor_matrix w -> tensor_row_replace x i w
 | Diff_to_scal_matrix ( y , w ) ->
  begin
   let xx = V.copy x in
    let xi = V.raw_extract i xx in
     V.replace ( Coeff.sub xi y ) i xx ;
     tensor_row_replace xx i w
  end
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   let xx = V.copy x
   and d = T.dimensions w
   and ii = Index.to_int i
   and h_a_l = ( Array.length a ) / 2 in
    let cc = pred ( Index.to_int d.(1) )
    and shift = ii - h_a_l in
     for j = max 0 shift to min ( ii + h_a_l ) cc do
      let jj = Index.from_int j in
       let xj = V.raw_extract jj xx in
        V.replace ( Coeff.sub xj a.( j - shift ) ) jj xx ;
     done ;
     tensor_row_replace xx i w
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let xx = V.copy x in
    let xi = V.raw_extract i xx in
     V.replace ( Coeff.sub xi a.( Index.to_int i ) ) i xx ;
     tensor_row_replace xx i w
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let xx = V.copy x
   and d = T.dimensions w
   and ii = Index.to_int i
   and h_a_l = ( Array.length a ) / 2 in
    let cc = pred ( Index.to_int d.(1) )
    and shift = ii - h_a_l in
     for j = max 0 shift to min ( ii + h_a_l ) cc do
      let jj = Index.from_int j in
       let xj = V.raw_extract jj xx in
        V.replace ( Coeff.sub xj a.( j - shift ).(ii) ) jj xx ;
     done ;
     tensor_row_replace xx i w
  end ;;


(** 
column_replace vector index matrix
This function is applied in place.

Cette fonction est exécutée en place. *)


let column_replace = fun (x:V.t) (i:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let f = function ( j , y ) -> V.replace y i w.( Index.to_int j ) in
    V.iter f x
  end
 | Sparse_tensor_matrix w -> tensor_column_replace x i w
 | Diff_to_scal_matrix ( y , w ) ->
  begin
   let xx = V.copy x in
    let xi = V.raw_extract i xx in
     V.replace ( Coeff.sub xi y ) i xx ;
     tensor_column_replace xx i w
  end
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   let xx = V.copy x
   and d = T.dimensions w
   and ii = Index.to_int i
   and h_a_l = ( Array.length a ) / 2 in
    let cc = pred ( Index.to_int d.(1) )
    and shift = ii - h_a_l
    and bound = ii + h_a_l in
     for j = max 0 shift to min bound cc do
      let jj = Index.from_int j in
       let xj = V.raw_extract jj xx in
        V.replace ( Coeff.sub xj a.( bound - j ) ) jj xx ;
     done ;
     tensor_column_replace xx i w
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let xx = V.copy x in
    let xi = V.raw_extract i xx in
     V.replace ( Coeff.sub xi a.( Index.to_int i ) ) i xx ;
     tensor_column_replace xx i w
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let xx = V.copy x
   and d = T.dimensions w
   and ii = Index.to_int i
   and h_a_l = ( Array.length a ) / 2 in
    let rr = pred ( Index.to_int d.(0) )
    and shift = ii - h_a_l
    and bound = ii + h_a_l in
     for j = max 0 shift to min bound rr do
      let jj = Index.from_int j in
       let xj = V.raw_extract jj xx in
        V.replace ( Coeff.sub xj a.( bound - j ).(j) ) jj xx ;
     done ;
     tensor_column_replace xx i w
  end ;;

(** 
replace coefficient row column matrix
*)

let replace = fun (x:coeff) (i:index) (j:index) (m:t) ->
 match m with
 | Half_full_matrix w -> V.replace x j w.( Index.to_int i )
 | Sparse_tensor_matrix w -> T.replace x [| i ; j |] w
 | Diff_to_scal_matrix ( y , w ) ->
  begin
   if Index.eq i j then
    T.replace ( Coeff.sub x y ) ( Array.make 2 i ) w
   else
    T.replace x [| i ; j |] w ;
  end
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   let h_a_l = ( Array.length a ) / 2
   and diff = Index.to_int ( Index.sub i j ) in
    if abs diff <= h_a_l then
     T.replace ( Coeff.sub x a.( h_a_l + diff ) ) [| i ; j |] w
    else
     T.replace x [| i ; j |] w ;
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   if Index.eq i j then
    begin
     a.( Index.to_int i ) <- x ;
     T.remove ( Array.make 2 i ) w ;
    end
   else
    T.replace x [| i ; j |] w ;
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let h_a_l = ( Array.length a ) / 2
   and diff = Index.to_int ( Index.sub i j ) in
    if abs diff <= h_a_l then
     begin
      try
       begin
        a.( h_a_l + diff ).( Index.to_int i ) <- x ;
        T.remove [| i ; j |] w
       end
      with _ ->
       T.replace x [| i ; j |] w
     end
    else
     T.replace x [| i ; j |] w ;
  end ;;

(** 
tensor_row_insert_add vector index matrix
*)

let tensor_row_insert_add = fun (x:V.t) (i:index) (w:T.t) ->
 let row = tensor_row_extract i w in
  let y = V.add x row in
   tensor_row_replace y i w ;;

(** 
tensor_column_insert_add vector index matrix
*)

let tensor_column_insert_add = fun (x:V.t) (i:index) (w:T.t) ->
 let column = tensor_column_extract i w in
  let y = V.add x column in
   tensor_column_replace y i w ;;

(** 
row_insert_add vector index matrix
*)

let row_insert_add = fun (x:V.t) (i:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let ii = Index.to_int i in
    w.(ii) <- V.add x w.(ii)
  end
 | Sparse_tensor_matrix w -> tensor_row_insert_add x i w
 | Diff_to_scal_matrix ( y , w ) -> tensor_row_insert_add x i w
 | Diff_to_multi_scal_matrix ( y , w ) -> tensor_row_insert_add x i w
 | Diff_to_diag_matrix ( a , w ) -> tensor_row_insert_add x i w
 | Diff_to_multi_diag_matrix ( a , w ) -> tensor_row_insert_add x i w ;;

(** 
column_insert_add vector index matrix
*)

let column_insert_add = fun (x:V.t) (i:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let f = function ( j , y ) -> V.insert_add y i w.( Index.to_int j ) in
    V.iter f x
  end
 | Sparse_tensor_matrix w -> tensor_column_insert_add x i w
 | Diff_to_scal_matrix ( y , w ) -> tensor_column_insert_add x i w
 | Diff_to_multi_scal_matrix ( y , w ) -> tensor_column_insert_add x i w
 | Diff_to_diag_matrix ( a , w ) -> tensor_column_insert_add x i w
 | Diff_to_multi_diag_matrix ( a , w ) -> tensor_column_insert_add x i w ;;

(** 
insert_add coefficient row column matrix
*)

let insert_add = fun (x:coeff) (i:index) (j:index) (m:t) ->
 match m with
 | Half_full_matrix w -> V.insert_add x j w.( Index.to_int i )
 | Sparse_tensor_matrix w -> T.insert_add x [| i ; j |] w
 | Diff_to_scal_matrix ( y , w ) -> T.insert_add x [| i ; j |] w
 | Diff_to_multi_scal_matrix ( a , w ) -> T.insert_add x [| i ; j |] w
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   if Index.eq i j then
    begin
     let ii = Index.to_int i in
      a.(ii) <- Coeff.add x a.(ii)
    end
   else
    T.insert_add x [| i ; j |] w
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let h_a_l = ( Array.length a ) / 2
   and diff = Index.to_int ( Index.sub i j ) in
    if abs diff <= h_a_l then
     begin
      try
       begin
        let ii = Index.to_int i
        and jj = h_a_l + diff in
         a.(jj).(ii) <- Coeff.add x a.(jj).(ii)
       end
      with _ ->
       T.insert_add x [| i ; j |] w
     end
    else
     T.insert_add x [| i ; j |] w
  end ;;

(** 
tensor_row_insert_sub vector index matrix
*)

let tensor_row_insert_sub = fun (x:V.t) (i:index) (w:T.t) ->
 let row = tensor_row_extract i w in
  let y = V.sub row x in
   tensor_row_replace y i w ;;

(** 
tensor_column_insert_sub vector index matrix
*)

let tensor_column_insert_sub = fun (x:V.t) (i:index) (w:T.t) ->
 let column = tensor_column_extract i w in
  let y = V.sub column x in
   tensor_column_replace y i w ;;

(** 
row_insert_sub vector index matrix
*)

let row_insert_sub = fun (x:V.t) (i:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let ii = Index.to_int i in
    w.(ii) <- V.sub w.(ii) x
  end
 | Sparse_tensor_matrix w -> tensor_row_insert_sub x i w
 | Diff_to_scal_matrix ( y , w ) -> tensor_row_insert_sub x i w
 | Diff_to_multi_scal_matrix ( y , w ) -> tensor_row_insert_sub x i w
 | Diff_to_diag_matrix ( a , w ) -> tensor_row_insert_sub x i w
 | Diff_to_multi_diag_matrix ( a , w ) -> tensor_row_insert_sub x i w ;;

(** 
column_insert_sub vector index matrix
*)

let column_insert_sub = fun (x:V.t) (i:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let f = function ( j , y ) -> V.insert_sub y i w.( Index.to_int j ) in
    V.iter f x
  end
 | Sparse_tensor_matrix w -> tensor_column_insert_sub x i w
 | Diff_to_scal_matrix ( y , w ) -> tensor_column_insert_sub x i w
 | Diff_to_multi_scal_matrix ( y , w ) -> tensor_column_insert_sub x i w
 | Diff_to_diag_matrix ( a , w ) -> tensor_column_insert_sub x i w
 | Diff_to_multi_diag_matrix ( a , w ) -> tensor_column_insert_sub x i w ;;

(** 
insert_sub coefficient row column matrix
*)

let insert_sub = fun (x:coeff) (i:index) (j:index) (m:t) ->
 match m with
 | Half_full_matrix w -> V.insert_sub x j w.( Index.to_int i )
 | Sparse_tensor_matrix w -> T.insert_sub x [| i ; j |] w
 | Diff_to_scal_matrix ( y , w ) -> T.insert_sub x [| i ; j |] w
 | Diff_to_multi_scal_matrix ( a , w ) -> T.insert_sub x [| i ; j |] w
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   if Index.eq i j then
    begin
     let ii = Index.to_int i in
      a.(ii) <- Coeff.sub a.(ii) x
    end
   else
    T.insert_sub x [| i ; j |] w
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let h_a_l = ( Array.length a ) / 2
   and diff = Index.to_int ( Index.sub i j ) in
    if abs diff <= h_a_l then
     begin
      try
       begin
        let ii = Index.to_int i
        and jj = h_a_l + diff in
         a.(jj).(ii) <- Coeff.sub a.(jj).(ii) x
       end
      with _ ->
       T.insert_sub x [| i ; j |] w
     end
    else
     T.insert_sub x [| i ; j |] w
  end ;;

(** 
tensor_diag_extract tensor
*)

let tensor_diag_extract = function (w:T.t) ->
 let ( e , t , v ) = T.flat_tensor_demakeup w
 and ensemble = ref ( T.M.H.B.empty () ) in
  let dim = T.M.dimension v
  and table = ( snd v ).T.M.H.data
  and rows = t.(0) in
   let d = Index.min dim.(0) dim.(1)
   and s = Array.length table in
    let diag = V.null d
    and f = function ( index , coefficient ) -> ensemble := T.M.H.B.union !ensemble table.( ( T.Multi_hash.raw_extract ( Array.make 2 index ) coefficient ) mod s ) in
     T.Info.iter f rows ;
     let g = function ( i , x ) ->
      begin
       let ii = i.(0) in
        if Index.eq ii i.(1) then
         V.insert_add x ii diag
      end in
      T.M.H.B.iter g !ensemble ;
      diag ;;

(** 
sparse_diag_extract tensor
*)

let sparse_diag_extract = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let dim = dimensions m in
    let d = Index.min dim.(0) dim.(1) in
     let diag = V.null d in
      for i = 0 to pred ( Array.length w ) do
       let ii = Index.from_int i in
        V.insert_add ( snd ( V.extract ii w.(i) ) ) ii diag
      done ;
      diag
  end
 | Sparse_tensor_matrix w -> tensor_diag_extract w
 | Diff_to_scal_matrix ( y , w ) ->
  begin
   if Coeff.eq_zero y then
    tensor_diag_extract w
   else
    failwith "Unadapted format in Sparse_matrix.Rng.sparse_diag_extract."
  end
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   if Coeff.eq_zero a.( ( Array.length a ) / 2 ) then
    tensor_diag_extract w
   else
    failwith "Unadapted format in Sparse_matrix.Rng.sparse_diag_extract."
  end
 | _ -> failwith "Unadapted format in Sparse_matrix.Rng.sparse_diag_extract."

(** 
full_diag_extract tensor
*)

let full_diag_extract = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let dim = dimensions m in
    let d = Index.min dim.(0) dim.(1) in
     let dd = Index.to_int d in
      let diag = Array.map Coeff.zero ( Array.make dd () ) in
       for i = 0 to pred dd do
        let ii = Index.from_int i in
         diag.(i) <- snd ( V.extract ii w.(i) )
       done ;
       diag
  end
 | Sparse_tensor_matrix w -> V.to_full ( tensor_diag_extract w )
 | Diff_to_scal_matrix ( y , w ) ->
  begin
   let diag = V.to_full ( tensor_diag_extract w ) in
    Array.map ( Coeff.add y ) diag
  end
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   let diag = V.to_full ( tensor_diag_extract w ) in
    Array.map ( Coeff.add a.( ( Array.length a ) / 2 ) ) diag
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let diag = V.to_full ( tensor_diag_extract w )
   and f = fun i x -> Coeff.add a.(i) x in
    Array.mapi f diag
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let diag = V.to_full ( tensor_diag_extract w )
   and f = fun i x -> Coeff.add a.( ( Array.length a ) / 2 ).(i) x in
    Array.mapi f diag
  end ;;

(** 
tensor_diag_isolate tensor
*)

let tensor_diag_isolate = function (w:T.t) ->
 let ( e , t , v ) = T.flat_tensor_demakeup w
 and ensemble = ref ( T.M.H.B.empty () ) in
  let dim = T.M.dimension v
  and table = ( snd v ).T.M.H.data
  and rows = t.(0) in
   let result = T.null dim
   and s = Array.length table in
    let f = function ( index , coefficient ) -> ensemble := T.M.H.B.union !ensemble table.( ( T.Multi_hash.raw_extract ( Array.make 2 index ) coefficient ) mod s ) in
     T.Info.iter f rows ;
     let g = function ( i , x ) -> if Index.eq i.(0) i.(1) then T.insert_add x i result in
      T.M.H.B.iter g !ensemble ;
      result ;;

(** 
diag_isolate matrix
*)

let diag_isolate = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let r = Array.length w
   and d = V.dimension w.(0) in
    let dd = Array.make r d in
     let accu = Array.map V.null dd in
      for i = 0 to pred ( min r ( Index.to_int d ) ) do
       let ii = Index.from_int i in
        try
         V.insert_add ( snd ( V.unsafe_extract ii w.(i) ) ) ii accu.(i)
        with _ ->
         ()
      done ;
      Half_full_matrix accu
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_diag_isolate w )
 | Diff_to_scal_matrix ( y , w ) -> Diff_to_scal_matrix ( y , tensor_diag_isolate w )
 | Diff_to_multi_scal_matrix ( a , w ) -> Diff_to_scal_matrix ( a.( ( Array.length a ) / 2 ) , tensor_diag_isolate w )
 | Diff_to_diag_matrix ( a , w ) -> Diff_to_diag_matrix ( a , tensor_diag_isolate w )
 | Diff_to_multi_diag_matrix ( a , w ) -> Diff_to_diag_matrix ( a.( ( Array.length a ) / 2 ) , tensor_diag_isolate w ) ;;

(** 
tensor_out_diag_isolate tensor
*)

let tensor_out_diag_isolate = function (w:T.t) ->
 let result = T.null ( T.dimensions w ) in
  let f = function ( i , x ) ->
   begin
    if not ( Index.eq i.(0) i.(1) ) then T.insert_add x i result
   end in
   T.iter f w ;
   result ;;

(** 
tensor_upper_diag_isolate tensor
*)

let tensor_upper_diag_isolate = function (w:T.t) ->
 let result = T.null ( T.dimensions w ) in
  let f = function ( i , x ) ->
   begin
    if Index.compare i.(0) i.(1) < 0 then T.insert_add x i result
   end in
   T.iter f w ;
   result ;;

(** 
tensor_lower_diag_isolate tensor
*)

let tensor_lower_diag_isolate = function (w:T.t) ->
 let result = T.null ( T.dimensions w ) in
  let f = function ( i , x ) ->
   begin
    if Index.compare i.(0) i.(1) > 0 then T.insert_add x i result
   end in
   T.iter f w ;
   result ;;

(** 
out_diag_isolate matrix
*)

let out_diag_isolate = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let r = Array.length w
   and d = V.dimension w.(0) in
    let accu = Array.map V.copy w in
     for i = 0 to pred ( min r ( Index.to_int d ) ) do
      let ii = Index.from_int i in
       V.remove ii accu.(i)
     done ;
     Half_full_matrix accu
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_out_diag_isolate w )
 | Diff_to_scal_matrix ( y , w ) -> Sparse_tensor_matrix ( tensor_out_diag_isolate w )
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   if Array.length a = 1 then
    Sparse_tensor_matrix ( tensor_out_diag_isolate w )
   else
    let b = Array.map Coeff.copy a in
     b.( ( Array.length a ) / 2 ) <- Coeff.zero () ;
     Diff_to_multi_scal_matrix ( b , tensor_out_diag_isolate w )
  end
 | Diff_to_diag_matrix ( a , w ) -> Sparse_tensor_matrix ( tensor_out_diag_isolate w )
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   if Array.length a = 1 then
    Sparse_tensor_matrix ( tensor_out_diag_isolate w )
   else
    let b = Array.map ( Array.map Coeff.copy ) a in
     b.( ( Array.length a ) / 2 ) <- Array.map Coeff.zero ( Array.make ( Array.length a.(0) ) () ) ;
     Diff_to_multi_diag_matrix ( b , tensor_out_diag_isolate w )
  end ;;

(** 
upper_diag_isolate matrix
*)

let upper_diag_isolate = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let r = Array.length w
   and d = V.dimension w.(0) in
    let accu = Array.map V.copy w in
     for i = 0 to pred ( min r ( Index.to_int d ) ) do
      let ii = Index.from_int ( succ i ) in
       accu.(i) <- V.ending ii w.(i)
     done ;
     Half_full_matrix accu
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_upper_diag_isolate w )
 | Diff_to_scal_matrix ( y , w ) -> Sparse_tensor_matrix ( tensor_upper_diag_isolate w )
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   if Array.length a = 1 then
    Sparse_tensor_matrix ( tensor_upper_diag_isolate w )
   else
    let h_a_l = ( Array.length a ) / 2 in
     let s_h_a_l = succ h_a_l in
      let aa = Array.map Coeff.zero ( Array.make s_h_a_l () )
      and aaa = Array.map Coeff.copy ( Array.sub a s_h_a_l h_a_l ) in
       let b = Array.append aa aaa in
        Diff_to_multi_scal_matrix ( b , tensor_upper_diag_isolate w )
  end
 | Diff_to_diag_matrix ( a , w ) -> Sparse_tensor_matrix ( tensor_upper_diag_isolate w )
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   if Array.length a = 1 then
    Sparse_tensor_matrix ( tensor_upper_diag_isolate w )
   else
    let h_a_l = ( Array.length a ) / 2 in
     let s_h_a_l = succ h_a_l in
      let aa = Array.map ( Array.map Coeff.zero ) ( Array.make_matrix s_h_a_l ( Array.length a.(0) ) () )
      and aaa = Array.map ( Array.map Coeff.copy ) ( Array.sub a s_h_a_l h_a_l ) in
       let b = Array.append aa aaa in
        Diff_to_multi_diag_matrix ( b , tensor_upper_diag_isolate w )
  end ;;

(** 
lower_diag_isolate matrix
*)

let lower_diag_isolate = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let r = Array.length w
   and d = V.dimension w.(0) in
    let accu = Array.map V.copy w in
     for i = 0 to pred ( min r ( Index.to_int d ) ) do
      let ii = Index.from_int ( pred i ) in
       accu.(i) <- V.beginning ii w.(i)
     done ;
     Half_full_matrix accu
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_lower_diag_isolate w )
 | Diff_to_scal_matrix ( y , w ) -> Sparse_tensor_matrix ( tensor_lower_diag_isolate w )
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   if Array.length a = 1 then
    Sparse_tensor_matrix ( tensor_lower_diag_isolate w )
   else
    let h_a_l = ( Array.length a ) / 2 in
     let s_h_a_l = succ h_a_l in
      let aa = Array.map Coeff.copy ( Array.sub a 0 h_a_l )
      and aaa = Array.map Coeff.zero ( Array.make s_h_a_l () ) in
       let b = Array.append aa aaa in
        Diff_to_multi_scal_matrix ( b , tensor_lower_diag_isolate w )
  end
 | Diff_to_diag_matrix ( a , w ) -> Sparse_tensor_matrix ( tensor_lower_diag_isolate w )
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   if Array.length a = 1 then
    Sparse_tensor_matrix ( tensor_lower_diag_isolate w )
   else
    let h_a_l = ( Array.length a ) / 2 in
     let s_h_a_l = succ h_a_l in
      let aa = Array.map ( Array.map Coeff.copy ) ( Array.sub a 0 h_a_l )
      and aaa = Array.map ( Array.map Coeff.zero ) ( Array.make_matrix s_h_a_l ( Array.length a.(0) ) () ) in
       let b = Array.append aa aaa in
        Diff_to_multi_diag_matrix ( b , tensor_lower_diag_isolate w )
  end ;;




(**
§
*)

(**

Coercitions

 *)

(**
*)





(** These functions are not sealed.

Ces fonctions ne sont pas étanches. *)




(** 
to_half_full matrix
*)

let to_half_full = function (m:t) ->
 let d = dimensions m
 in
  try
   begin
    match m with
    | Half_full_matrix w -> m
    | Sparse_tensor_matrix w ->
     begin
      let r = Index.to_int d.(0) in
       let dd = Array.make r d.(1) in
        let accu = Array.map V.null dd in
         let f = function ( i , y ) -> V.insert_add y i.(1) accu.( Index.to_int i.(0) ) in
          T.iter f w ;
          Half_full_matrix accu
     end
    | Diff_to_scal_matrix ( x , w ) ->
     begin
      let r = Index.to_int d.(0) in
       let dd = Array.make r d.(1) in
        let accu = Array.map V.null dd in
         let f = function ( i , y ) -> V.insert_add y i.(1) accu.( Index.to_int i.(0) ) in
          T.iter f w ;
          for i = 0 to pred r do
           V.insert_add x ( Index.from_int i ) accu.(i)
          done ;
          Half_full_matrix accu
     end
    | Diff_to_multi_scal_matrix ( a , w ) ->
     begin
      let r = Index.to_int d.(0)
      and c = Index.to_int d.(1)
      and alength = Array.length a in
       if alength mod 2 = 0 then failwith "Bad multi-scalar dimension in Sparse_matrix.Rng.to_half_full." ;
       let dd = Array.make r d.(1)
       and cc = pred c
       and h_a_l = alength / 2 in
        let accu = Array.map V.null dd in
         let f = function ( i , x ) -> V.insert_add x i.(1) accu.( Index.to_int i.(0) ) in
          T.iter f w ;
          for i = 0 to pred r do
           let row = accu.(i)
           and i_i = i - h_a_l
           and ii = i + h_a_l in
            for j = max 0 i_i to min ii cc do
             let jj = j - i_i in
              V.insert_add a.(jj) ( Index.from_int j ) row
            done
          done ;
          Half_full_matrix accu
     end
    | Diff_to_diag_matrix ( a , w ) ->
     begin
      let r = Index.to_int d.(0) in
       let dd = Array.make r d.(1) in
        let accu = Array.map V.null dd in
         let f = function ( i , y ) -> V.insert_add y i.(1) accu.( Index.to_int i.(0) ) in
          T.iter f w ;
          for i = 0 to pred ( min ( Array.length a ) r ) do
           V.insert_add a.(i) ( Index.from_int i ) accu.(i)
          done ;
          Half_full_matrix accu
     end
    | Diff_to_multi_diag_matrix ( a , w ) ->
     begin
      let r = Index.to_int d.(0)
      and c = Index.to_int d.(1)
      and alength = Array.length a in
       if alength mod 2 = 0 then failwith "Bad multi-diagonal dimension in Sparse_matrix.Rng.to_half_full." ;
       let dd = Array.make r d.(1)
       and cc = pred c
       and h_a_l = alength / 2 in
        let accu = Array.map V.null dd in
         let f = function ( i , y ) -> V.insert_add y i.(1) accu.( Index.to_int i.(0) ) in
          T.iter f w ;
          for i = 0 to pred r do
           let row = accu.(i)
           and i_i = i - h_a_l
           and ii = i + h_a_l in
            for j = max 0 i_i to min ii cc do
             let jj = j - i_i in
              V.insert_add a.(jj).(i) ( Index.from_int j ) row
            done
          done ;
          Half_full_matrix accu
     end
   end
  with _ ->
   let dd = Index.to_int d.(0) in
    Half_full_matrix ( Array.map V.null ( Array.make dd d.(1) ) ) ;;

(** 
to_sparse_tensor matrix
*)

let to_sparse_tensor = function (mm:t) -> 
 let m = copy mm in
  match m with
  | Sparse_tensor_matrix w -> m
  | Diff_to_scal_matrix ( x , w ) ->
   begin
    let d = T.dimensions w in
     for i = 0 to pred ( min ( Index.to_int d.(0) ) ( Index.to_int d.(1) ) ) do
      let j = Index.from_int i in
       T.insert_add x ( Array.make 2 j ) w
     done ;
     Sparse_tensor_matrix w
   end
  | Diff_to_multi_scal_matrix ( a , w ) ->
   begin
    let d = T.dimensions w
    and alength = Array.length a in
     if alength mod 2 = 0 then failwith "Bad multi-scalar dimension in Sparse_matrix.Rng.to_half_full." ;
     let r = Index.to_int d.(0)
     and c = Index.to_int d.(1)
     and h_a_l = alength / 2 in
      let cc = pred c in
       for i = 0 to pred r do
        let i_i = i - h_a_l
        and ii = i + h_a_l in
         for j = max 0 i_i to min ii cc do
          let jj = j - i_i in
           T.insert_add a.(jj) [| Index.from_int i ; Index.from_int j |] w
         done ;
       done ;
       Sparse_tensor_matrix w
   end
  | Half_full_matrix w ->
   begin
    let u = T.null ( dimensions m )
    and r = Array.length w in
     let f = fun k ( j , y ) -> T.insert_add y [| Index.from_int k ; j |] u in
      for i = 0 to pred r do
       V.iter ( f i ) w.(i)
      done ;
      Sparse_tensor_matrix u
   end
  | Diff_to_diag_matrix ( a , w ) ->
   begin
    let d = T.dimensions w in
     for i = 0 to pred ( min ( Index.to_int d.(0) ) ( Index.to_int d.(1) ) ) do
      let j = Index.from_int i in
       T.insert_add a.(i) ( Array.make 2 j ) w
     done ;
     Sparse_tensor_matrix w
   end
  | Diff_to_multi_diag_matrix ( a , w ) ->
   begin
    let d = T.dimensions w
    and alength = Array.length a in
     if alength mod 2 = 0 then failwith "Bad multi-scalar dimension in Sparse_matrix.Rng.to_half_full." ;
     let r = Index.to_int d.(0)
     and c = Index.to_int d.(1)
     and h_a_l = alength / 2 in
      let cc = pred c in
       for i = 0 to pred r do
        let i_i = i - h_a_l
        and ii = i + h_a_l in
         for j = max 0 i_i to min ii cc do
          let jj = j - i_i in
           T.insert_add a.(jj).(i) [| Index.from_int i ; Index.from_int j |] w
         done ;
       done ;
       Sparse_tensor_matrix w
   end ;;

(** 
to_diff_to_scal matrix
*)

let rec to_diff_to_scal = function (mmm:t) ->
 let m = copy mmm in
  match m with
  | Sparse_tensor_matrix w -> Diff_to_scal_matrix ( Coeff.zero () , w )
  | Diff_to_scal_matrix ( x , w ) -> m
  | Diff_to_multi_scal_matrix ( a , w ) ->
   begin
    let r = Array.length a in
     let rr = r / 2 in
      let x = a.(rr) in
       a.(rr) <- Coeff.zero () ;
       let mm = to_sparse_tensor ( Diff_to_multi_scal_matrix ( a , w ) ) in
        let ww = sparse_tensor_matrix_demakeup mm in
         Diff_to_scal_matrix ( x , ww ) 
   end
  | Half_full_matrix w -> to_diff_to_scal ( to_sparse_tensor m )
  | Diff_to_diag_matrix ( a , w ) -> to_diff_to_scal ( to_sparse_tensor m )
  | Diff_to_multi_diag_matrix ( a , w ) -> to_diff_to_scal ( to_sparse_tensor m ) ;;

(** 
to_diff_to_multi_scal matrix
*)

let rec to_diff_to_multi_scal = function (mm:t) ->
 let m = copy mm in
  match m with
  | Sparse_tensor_matrix w -> Diff_to_multi_scal_matrix ( [| Coeff.zero () |], w )
  | Diff_to_scal_matrix ( x , w ) -> Diff_to_multi_scal_matrix ( [| x |], w )
  | Diff_to_multi_scal_matrix ( a , w ) -> m
  | Half_full_matrix w -> to_diff_to_multi_scal ( to_diff_to_scal m )
  | Diff_to_diag_matrix ( a , w ) -> to_diff_to_multi_scal ( to_diff_to_scal m )
  | Diff_to_multi_diag_matrix ( a , w ) -> to_diff_to_multi_scal ( to_diff_to_scal m ) ;;

(** 
to_diff_to_diag matrix
*)

let rec to_diff_to_diag = function (mm:t) ->
 let m = copy mm in
  match m with
  | Sparse_tensor_matrix w ->
   begin
    let r = Index.to_int ( T.dimensions w ).(0) in
     let a = Array.map Coeff.zero ( Array.make r () ) in
      Diff_to_diag_matrix ( a , w )
   end
  | Diff_to_scal_matrix ( x , w ) ->
   begin
    let r = Index.to_int ( T.dimensions w ).(0) in
     let a = Array.map Coeff.copy ( Array.make r x ) in
      Diff_to_diag_matrix ( a , w )
   end
  | Diff_to_multi_scal_matrix ( a , w ) ->
   begin
    let r = Array.length a
    and d = Index.to_int ( T.dimensions w ).(0) in
     let rr = r / 2 in
      let x = a.(rr) in
       a.(rr) <- Coeff.zero () ;
       let mm = to_sparse_tensor ( Diff_to_multi_scal_matrix ( a , w ) )
       and b = Array.map Coeff.copy ( Array.make d x ) in
        let ww = sparse_tensor_matrix_demakeup mm in
         Diff_to_diag_matrix ( b , ww ) 
   end
  | Half_full_matrix w -> to_diff_to_diag ( to_sparse_tensor m )
  | Diff_to_diag_matrix ( a , w ) -> m
  | Diff_to_multi_diag_matrix ( a , w ) ->
   begin
    let r = Array.length a
    and d = Index.to_int ( T.dimensions w ).(0) in
     let rr = r / 2 in
      let b = a.(rr) in
       a.(rr) <- Array.map Coeff.zero ( Array.make d () ) ;
       let mm = to_sparse_tensor ( Diff_to_multi_diag_matrix ( a , w ) ) in
        let ww = sparse_tensor_matrix_demakeup mm in
         Diff_to_diag_matrix ( b , ww ) 
   end ;;

(** 
to_diff_to_multi_diag matrix
*)

let rec to_diff_to_multi_diag = function (mm:t) ->
 let m = copy mm in
  match m with
  | Sparse_tensor_matrix w ->
   begin
    let r = Index.to_int ( T.dimensions w ).(0) in
     let a = [| Array.map Coeff.zero ( Array.make r () ) |] in
      Diff_to_multi_diag_matrix ( a , w )
   end
  | Diff_to_scal_matrix ( x , w ) ->
   begin
    let r = Index.to_int ( T.dimensions w ).(0) in
     let a = [| Array.map Coeff.copy ( Array.make r x ) |] in
      Diff_to_multi_diag_matrix ( a , w )
   end
  | Diff_to_multi_scal_matrix ( a , w ) ->
   begin
    let d = Index.to_int ( T.dimensions w ).(0) in
     let b = Array.map ( Array.make d ) a in
      Diff_to_multi_diag_matrix ( b , w ) 
   end
  | Half_full_matrix w -> to_diff_to_multi_diag ( to_sparse_tensor m )
  | Diff_to_diag_matrix ( a , w ) -> Diff_to_multi_diag_matrix ( [| a |] , w ) 
  | Diff_to_multi_diag_matrix ( a , w ) -> m ;;

(** 
half_full_matrix_to_full matrix
*)

let half_full_matrix_to_full = function (m:t) ->
 match m with
 | Half_full_matrix w -> Array.map ( V.to_full ) w
 | _ -> failwith "Not a half full matrix in Sparse_matrix.Rng.half_full_matrix_to_full." ;;

(** 
sparse_tensor_to_full_matrix tensor
*)

let sparse_tensor_to_full_matrix = function (w:T.t) ->
 let d = T.dimensions w in
  let m = Array.map ( Array.map Coeff.zero ) ( Array.make_matrix ( Index.to_int d.(0) ) ( Index.to_int d.(1) ) () ) in
   let f = function ( i , x ) -> ( m.( Index.to_int i.(0) ).( Index.to_int i.(1) ) <- x ) in
    T.iter f w ;
    m ;;

(** 
sparse_tensor_matrix_to_full matrix
*)

let sparse_tensor_matrix_to_full = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> sparse_tensor_to_full_matrix w
 | _ -> failwith "Not a sparse tensor matrix in Sparse_matrix.Rng.sparse_tensor_matrix_to_full." ;;

(** 
diff_to_scal_matrix_to_full matrix
*)

let diff_to_scal_matrix_to_full = function (m:t) ->
 match m with
 | Diff_to_scal_matrix ( x , w ) ->
  begin
   let m = sparse_tensor_to_full_matrix w in
    for i = 0 to pred ( min ( Array.length m ) ( Array.length m.(0) ) ) do
     m.(i).(i) <- Coeff.add m.(i).(i) x ;
    done ;
    m
  end
 | _ -> failwith "Not a difference-to-scalar matrix in Sparse_matrix.Rng.diff_to_scal_matrix_to_full." ;;

(** 
diff_to_multi_scal_matrix_to_full matrix
*)

let diff_to_multi_scal_matrix_to_full = function (m:t) ->
 match m with
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   let m = sparse_tensor_to_full_matrix w
   and h_a_l = ( Array.length a ) / 2 in
    let cc = pred ( Array.length m.(0) ) in
     for i = 0 to pred ( Array.length m ) do
      let row = m.(i)
      and ii = i - h_a_l in
       for j = max 0 ii to min cc ( i + h_a_l ) do
        row.(j) <- Coeff.add row.(j) a.( j - ii ) ;
       done ;
     done ;
     m
  end
 | _ -> failwith "Not a difference-to-multi-scalar matrix in Sparse_matrix.Rng.diff_to_multi_scal_matrix_to_full." ;;

(** 
diff_to_diag_matrix_to_full matrix
*)

let diff_to_diag_matrix_to_full = function (m:t) ->
 match m with
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let m = sparse_tensor_to_full_matrix w in
    for i = 0 to pred ( min ( Array.length m ) ( Array.length m.(0) ) ) do
     m.(i).(i) <- Coeff.add m.(i).(i) a.(i) ;
    done ;
    m
  end
 | _ -> failwith "Not a difference-to-diagonal matrix in Sparse_matrix.Rng.diff_to_diag_matrix_to_full." ;;

(** 
diff_to_multi_diag_matrix_to_full matrix
*)

let diff_to_multi_diag_matrix_to_full = function (m:t) ->
 match m with
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let m = sparse_tensor_to_full_matrix w
   and h_a_l = ( Array.length a ) / 2 in
    let cc = pred ( Array.length m.(0) ) in
     for i = 0 to pred ( Array.length m ) do
      let row = m.(i)
      and ii = i - h_a_l in
       for j = max 0 ii to min cc ( i + h_a_l ) do
        row.(j) <- Coeff.add row.(j) a.( j - ii ).(i) ;
       done ;
     done ;
     m
  end
 | _ -> failwith "Not a difference-to-multi-diagonal matrix in Sparse_matrix.Rng.diff_to_multi_diag_matrix_to_full." ;;

(** 
to_full matrix
*)

let to_full = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> sparse_tensor_matrix_to_full m
 | Half_full_matrix w -> half_full_matrix_to_full m
 | Diff_to_scal_matrix ( x , w ) -> diff_to_scal_matrix_to_full m
 | Diff_to_multi_scal_matrix ( a , w ) -> diff_to_multi_scal_matrix_to_full m
 | Diff_to_diag_matrix ( a , w ) -> diff_to_diag_matrix_to_full m
 | Diff_to_multi_diag_matrix ( a , w ) -> diff_to_multi_diag_matrix_to_full m ;;

(** 
to_sparse size threshold matrix
*)

let to_sparse = fun (size:int) (threshold:float) (m:coeff array array) ->
 let r = Array.length m
 and c = Array.length m.(0)
 and filling_diag = ref 0
 and filling_rows = ref 0 in
  let cc = Index.from_int c
  and tt = threshold *. ( float r )
  and wide = r <= c
  and rr = pred r
  and result = ref ( T.null [| Index.from_int r ; Index.from_int c |] )
  and diag = Array.map Coeff.zero ( Array.make r () ) in
   let with_diag = Array.map V.null ( Array.make r cc )
   and marked_rows = ref [] in
    for i = 0 to rr do
     let row_input = m.(i) in
      let row_output = V.to_sparse size row_input in
       if V.filling row_output > 0 then
        marked_rows := i :: !marked_rows ;
       with_diag.(i) <- row_output ;
       if not ( V.eq_zero row_output ) then
        incr filling_rows ;
       if wide then
        begin
         let x = row_input.(i) in
          if not ( Coeff.eq_zero x ) then
           begin
            diag.(i) <- x ;
            incr filling_diag ;
           end ;
        end
    done ;
    let diag_is_small = ( not wide ) || ( tt > ( float !filling_diag ) ) in
     if diag_is_small then
      begin
       let few_rows = tt > ( float !filling_rows ) in
        if few_rows then
         begin
          let f = fun i ( j , y ) -> T.insert_add y [| Index.from_int i ; j |] !result in
           while Util.list_non_empty !marked_rows do
            let i = List.hd !marked_rows in
             V.iter ( f i ) with_diag.(i) ;
             marked_rows := List.tl !marked_rows ;
           done ;
           Sparse_tensor_matrix !result
         end
        else
         Half_full_matrix with_diag
      end
     else
      begin
       let f = fun i ( j , y ) -> T.insert_add y [| Index.from_int i ; j |] !result in
        while Util.list_non_empty !marked_rows do
         let i = List.hd !marked_rows in
          V.remove ( Index.from_int i ) with_diag.(i) ;
          V.iter ( f i ) with_diag.(i) ;
          marked_rows := List.tl !marked_rows ;
        done ;
        Diff_to_diag_matrix ( diag , !result )
      end ;;

(** 
auto_to_sparse threshold matrix
*)

let auto_to_sparse = fun (threshold:float) (m:coeff array array) ->
 to_sparse (-1) threshold m ;;

(** 
sparse_vector_to_line_matrix vector
*)

let sparse_vector_to_line_matrix = function (v:V.t) ->
 Half_full_matrix [| v |] ;;


(** 
sparse_vector_to_square_matrix vector
The vector is placed in the first row.

Le vecteur est placé dans la première ligne. *)


let sparse_vector_to_square_matrix = function (v:V.t) ->
 let result = T.null ( Array.make 2 ( V.dimension v ) ) in
  let f = function ( i , x ) -> T.insert_add x [| Index.zero () ; i |] result in
   V.iter f v ;
   Sparse_tensor_matrix result ;;



(** 
full_vector_to_square_matrix vector
The vector is placed in the first row.

Le vecteur est placé dans la première ligne. *)


let full_vector_to_square_matrix = function (v:coeff array) ->
 let r = Array.length v in
  let rr = Index.from_int r in
   let result = T.null ( Array.make 2 rr ) in
    for i = 0 to pred r do
     let ii = Index.from_int i in
      T.insert_add v.(i) [| Index.zero () ; ii |] result ;
    done ;
    Sparse_tensor_matrix result ;;




(**
§
*)

(**

Autres opérations

Other operations

 *)

(**
*)





(** 
eq_zero matrix
This verification of nullity is correct, provided that the dimensions be not too big.

Cette vérification de nullité est correcte, à condition que les dimensions ne soient pas trop grandes. *)


let rec eq_zero = function (m:t) ->
 match m with
 | Sparse_tensor_matrix w  -> T.eq_zero w
 | Half_full_matrix w ->
  begin
   let r = Array.length w
   and i = ref 0
   and accu = ref true in
    if !accu then
     begin
      while !i < r do
       accu := V.eq_zero w.(!i) ;
       if !accu then
        incr i
       else
        i := r ;
      done ;
      !accu
     end
    else
     !accu
  end
 | _ -> eq_zero ( to_half_full m ) ;;

(** 
in_place_transpose matrix
*)

let rec in_place_transpose = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let d = dimensions m
   and mm = to_sparse_tensor m in
    if not ( Index.eq d.(0) d.(1) ) then
     failwith "Not a square half_full matrix in Sparse_matrix.Rng.in_place_transpose." ;
    for i = 0 to pred ( Array.length w ) do
     w.(i) <- column_extract ( Index.from_int i ) mm
    done ;
  end
 | Sparse_tensor_matrix w -> T.level_exchange 0 1 w
 | Diff_to_scal_matrix ( y , w ) -> T.level_exchange 0 1 w
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   T.level_exchange 0 1 w ;
   let accu = ref a.(0)
   and r = pred ( Array.length a ) in
    for i = 0 to pred ( r / 2 ) do
     let ii = r - i in
      accu := a.(i) ;
      a.(i) <- a.(ii) ;
      a.(ii) <- !accu ;
    done ;
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   T.level_exchange 0 1 w ;
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   T.level_exchange 0 1 w ;
   let accu = ref a.(0)
   and r = pred ( Array.length a ) in
    let r2 = r / 2 in
     for i = 0 to pred r2 do
      let ii = r - i
      and shift = r2 - i in
       accu := a.(i) ;
       a.(i) <- Array.append ( Array.map Coeff.zero ( Array.make shift () ) ) a.(ii) ;
       a.(ii) <- Util.array_end shift !accu ;
     done ;
  end ;;

(** 
transpose matrix
*)

let transpose = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let d = dimensions m
   and mm = to_sparse_tensor m in
    let r = Index.to_int d.(1) in
     let ww = Array.map V.null ( Array.make r d.(0) ) in
      for i = 0 to pred r do
       ww.(i) <- column_extract ( Index.from_int i ) mm
      done ;
      Half_full_matrix ww
  end
 | _ ->
  begin
   let mm = copy m in
    in_place_transpose mm ;
    mm
  end ;;

(** 
sparse_vector_to_column_matrix vector
*)

let sparse_vector_to_column_matrix = function (v:V.t) ->
 transpose ( sparse_vector_to_line_matrix v ) ;;


(** 
raw_find coefficient matrix
If the coefficient x is null, the search fails.

Si le coefficient x est nul, la recherche échoue. *)


let raw_find = fun (x:coeff) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let r = Array.length w
   and row_index = ref ( Index.witness () )
   and column_index = ref ( Index.witness () )
   and i = ref 0 in
    while !i < r do
     column_index := V.find x w.(!i) ;
     if not ( Index.eq ( Index.witness () ) !column_index ) then
      begin
       row_index := Index.from_int !i ;
       i := r
      end
     else
      incr i
    done ;
    [| !row_index ; !column_index |]
  end
 | Sparse_tensor_matrix w -> T.find x w
 | Diff_to_scal_matrix ( y , w ) -> T.find x w
 | Diff_to_multi_scal_matrix ( y , w ) -> T.find x w
 | Diff_to_diag_matrix ( a , w ) -> T.find x w
 | Diff_to_multi_diag_matrix ( a , w ) -> T.find x w ;;


(** 
find coefficient matrix
If the coefficient x is null, the search fails.

Si le coefficient x est nul, la recherche échoue. *)


let find = fun (x:coeff) (m:t) ->
 match m with
 | Half_full_matrix w -> raw_find x m
 | Sparse_tensor_matrix w -> T.find x w
 | _ -> raw_find x ( to_half_full m ) ;;

(** 
tensor_sub_row_iter function index beginning ending tensor
*)

let tensor_sub_row_iter = fun f (i:index) (beginning:index) (ending:index) (w:T.t) ->
 let ( e , t , v ) = T.flat_tensor_demakeup w in
  let candidates = T.Multi_hash.mask_vector [| i ; beginning |] [| i ; ending |] ( T.Info.raw_extract i t.(0) )
  and ( dim , table ) = v in
   let ensemble = Array.fold_left T.Multi_hash.H.B.union ( T.Multi_hash.H.B.empty () ) ( snd candidates ).T.Multi_hash.H.data
   and tab = table.T.M.H.data in
    let s = Array.length tab in
     let g = function ( j , x ) ->
      begin
       let j1 = j.(1) in
        if ( Index.eq i j.(0) ) && ( Index.compare beginning j1 <= 0 ) && ( Index.compare j1 ending <= 0 ) then
         f ( j , x )
      end in
      let h = function ( j , x ) -> T.M.H.B.iter g tab.( x mod s ) in
       T.Multi_hash.H.B.iter h ensemble ;;

(** 
tensor_sub_row_extract index beginning ending tensor
*)

let tensor_sub_row_extract = fun (i:index) (beginning:index) (ending:index) (w:T.t) ->
 let result = V.null ( T.dimensions w ).(1) in
  let f = function ( j , x ) -> V.insert_add x j.(1) result in
   tensor_sub_row_iter f i beginning ending w ;
   result ;;

(** 
tensor_sub_column_iter function index beginning ending tensor
*)

let tensor_sub_column_iter = fun f (i:index) (beginning:index) (ending:index) (w:T.t) ->
 let ( e , t , v ) = T.flat_tensor_demakeup w in
  let candidates = T.Multi_hash.mask_vector [| beginning ; i |] [| ending ; i |] ( T.Info.raw_extract i t.(1) )
  and ( dim , table ) = v in
   let ensemble = Array.fold_left T.Multi_hash.H.B.union ( T.Multi_hash.H.B.empty () ) ( snd candidates ).T.Multi_hash.H.data
   and tab = table.T.M.H.data in
    let s = Array.length tab in
     let g = function ( j , x ) ->
      begin
       let j0 = j.(0) in
        if ( Index.eq i j.(1) ) && ( Index.compare beginning j0 <= 0 ) && ( Index.compare j0 ending <= 0 ) then
         f ( j , x )
      end in
      let h = function ( j , x ) -> T.M.H.B.iter g tab.( x mod s ) in
       T.Multi_hash.H.B.iter h ensemble ;;

(** 
tensor_sub_column_extract index beginning ending tensor
*)

let tensor_sub_column_extract = fun (i:index) (beginning:index) (ending:index) (w:T.t) ->
 let result = V.null ( T.dimensions w ).(0) in
  let f = function ( j , x ) -> V.insert_add x j.(0) result in
   tensor_sub_column_iter f i beginning ending w ;
   result ;;

(** 
tensor_hor_band_iter function beginning ending tensor
*)

let tensor_hor_band_iter = fun f (beginning:index) (ending:index) (w:T.t) ->
 let g = function ( i , x ) ->
  begin
   let ii = i.(0) in
    if ( Index.compare ii beginning >= 0 ) && ( Index.compare ii ending <= 0 ) then
     f ( i , x )
  end in
  T.iter g w ;;

(** 
tensor_masked_hor_band beginning ending tensor
*)

let tensor_masked_hor_band = fun (beginning:index) (ending:index) (w:T.t) ->
 let result = T.null ( T.dimensions w ) in
  let f = function ( i , x ) -> T.insert_add x i result in
   tensor_hor_band_iter f beginning ending w ;
   result ;;

(** 
tensor_hor_band beginning ending tensor
*)

let tensor_hor_band = fun (beginning:index) (ending:index) (w:T.t) ->
 let d = T.dimensions w in
  let result = T.null [| Index.succ ( Index.sub ending beginning ) ; d.(1) |] in
   let f = function ( i , x ) -> T.insert_add x [| Index.sub i.(0) beginning ; i.(1) |] result in
    tensor_hor_band_iter f beginning ending w ;
    result ;;

(** 
tensor_vert_band_iter function beginning ending tensor
*)

let tensor_vert_band_iter = fun f (beginning:index) (ending:index) (w:T.t) ->
 let g = function ( i , x ) ->
  begin
   let ii = i.(1) in
    if ( Index.compare ii beginning >= 0 ) && ( Index.compare ii ending <= 0 ) then
     f ( i , x )
  end in
  T.iter g w ;;

(** 
tensor_masked_vert_band beginning ending tensor
*)

let tensor_masked_vert_band = fun (beginning:index) (ending:index) (w:T.t) ->
 let result = T.null ( T.dimensions w ) in
  let f = function ( i , x ) -> T.insert_add x i result in
   tensor_vert_band_iter f beginning ending w ;
   result ;;

(** 
tensor_vert_band beginning ending tensor
*)

let tensor_vert_band = fun (beginning:index) (ending:index) (w:T.t) ->
 let d = T.dimensions w in
  let result = T.null [| d.(0) ; Index.succ ( Index.sub ending beginning ) |] in
   let f = function ( i , x ) -> T.insert_add x [| i.(0) ; Index.sub i.(1) beginning |] result in
    tensor_vert_band_iter f beginning ending w ;
    result ;;

(** 
tensor_head_iter function vert_ending hor_ending tensor
*)

let tensor_head_iter = fun f (vert_ending:index) (hor_ending:index) (w:T.t) ->
 let g = function ( i , x ) ->
  begin
   if ( Index.compare i.(0) vert_ending <= 0 ) && ( Index.compare i.(1) hor_ending <= 0 ) then
    f ( i , x )
  end in
  T.iter g w ;;

(** 
tensor_masked_head vert_ending hor_ending tensor
*)

let tensor_masked_head = fun (vert_ending:index) (hor_ending:index) (w:T.t) ->
 let result = T.null ( T.dimensions w ) in
  let f = function ( i , x ) -> T.insert_add x i result in
   tensor_head_iter f vert_ending hor_ending w ;
   result ;;

(** 
tensor_head vert_ending hor_ending tensor
*)

let tensor_head = fun (vert_ending:index) (hor_ending:index) (w:T.t) ->
 let result = T.null [| Index.succ vert_ending ; Index.succ hor_ending |] in
  let f = function ( i , x ) -> T.insert_add x i result in
   tensor_head_iter f vert_ending hor_ending w ;
   result ;;

(** 
tensor_tail_iter function vert_beginning hor_beginning tensor
*)

let tensor_tail_iter = fun f (vert_beginning:index) (hor_beginning:index) (w:T.t) ->
 let g = function ( i , x ) ->
  begin
   if ( Index.compare i.(0) vert_beginning >= 0 ) && ( Index.compare i.(1) hor_beginning >= 0 ) then
    f ( i , x )
  end in
  T.iter g w ;;

(** 
tensor_masked_tail vert_beginning hor_beginning tensor
*)

let tensor_masked_tail = fun (vert_beginning:index) (hor_beginning:index) (w:T.t) ->
 let result = T.null ( T.dimensions w ) in
  let f = function ( i , x ) -> T.insert_add x i result in
   tensor_tail_iter f vert_beginning hor_beginning w ;
   result ;;

(** 
tensor_tail vert_beginning hor_beginning tensor
*)

let tensor_tail = fun (vert_beginning:index) (hor_beginning:index) (w:T.t) ->
 let d = T.dimensions w in
  let result = T.null [| Index.sub d.(0) vert_beginning ; Index.sub d.(1) hor_beginning |] in
   let f = function ( i , x ) -> T.insert_add x [| Index.sub i.(0) vert_beginning ; Index.sub i.(1) hor_beginning |] result in
   tensor_tail_iter f vert_beginning hor_beginning w ;
    result ;;

(** 
tensor_sample_iter function vert_beginning vert_ending hor_beginning hor_ending tensor
*)

let tensor_sample_iter = fun f (vert_beginning:index) (vert_ending:index) (hor_beginning:index) (hor_ending:index) (w:T.t) ->
 let g = function ( i , x ) ->
  begin
   let row = i.(0)
   and column = i.(1) in
    if ( Index.compare row vert_beginning >= 0 ) && ( Index.compare row vert_ending <= 0 ) && ( Index.compare column hor_beginning >= 0 ) && ( Index.compare column hor_ending <= 0 ) then
     f ( i , x )
  end in
  T.iter g w ;;

(** 
tensor_masked_sample vert_beginning vert_ending hor_beginning hor_ending tensor
*)

let tensor_masked_sample = fun (vert_beginning:index) (vert_ending:index) (hor_beginning:index) (hor_ending:index) (w:T.t) ->
 let result = T.null ( T.dimensions w ) in
  let f = function ( i , x ) -> T.insert_add x i result in
   tensor_sample_iter f vert_beginning vert_ending hor_beginning hor_ending w ;
   result ;;

(** 
tensor_sample vert_beginning vert_ending hor_beginning hor_ending tensor
*)

let tensor_sample = fun (vert_beginning:index) (vert_ending:index) (hor_beginning:index) (hor_ending:index) (w:T.t) ->
 let r = Index.succ ( Index.sub vert_ending vert_beginning )
 and c = Index.succ ( Index.sub hor_ending hor_beginning ) in
  let result = T.null [| r ; c |] in
   let f = function ( i , x ) -> T.insert_add x [| Index.sub i.(0) vert_beginning ; Index.sub i.(1) hor_beginning |] result in
    tensor_sample_iter f vert_beginning vert_ending hor_beginning hor_ending w ;
    result ;;

(** 
masked_hor_band beginning ending matrix
*)

let rec masked_hor_band = fun (beginning:index) (ending:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let d = V.dimension w.(0)
   and b = Index.to_int beginning
   and e = Index.to_int ending
   and r = Array.length w in
    let result = Array.map V.null ( Array.make r d ) in
     for i = max 0 b to min ( pred r ) e do
      result.(i) <- w.(i)
     done ;
     Half_full_matrix result
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_masked_hor_band beginning ending w )
 | Diff_to_scal_matrix ( y , w ) -> masked_hor_band beginning ending ( to_diff_to_diag m )
 | Diff_to_multi_scal_matrix ( y , w ) -> masked_hor_band beginning ending ( to_diff_to_multi_diag m )
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let b = Index.to_int beginning
   and e = Index.to_int ending
   and r = Array.length a in
    let aa = Array.map Coeff.zero ( Array.make r () ) in
     for i = max 0 b to min ( pred r ) e do
      aa.(i) <- a.(i)
     done ;
     Diff_to_diag_matrix ( aa , tensor_masked_hor_band beginning ending w )
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let b = Index.to_int beginning
   and e = Index.to_int ending
   and r = Array.length a
   and c = Array.length a.(0) in
    let aa = Array.map ( Array.map Coeff.zero ) ( Array.make_matrix r c () ) in
     for i = 0 to pred r do
      let output = aa.(i)
      and input = a.(i) in
       for j = b to e do
        output.(j) <- input.(j)
       done ;
     done ;
     Diff_to_multi_diag_matrix ( aa , tensor_masked_hor_band beginning ending w )
  end ;;

(** 
masked_vert_band beginning ending matrix
*)

let rec masked_vert_band = fun (beginning:index) (ending:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let d = V.dimension w.(0)
   and r = Array.length w in
    let result = Array.map V.null ( Array.make r d ) in
     for i = 0 to pred r do
      result.(i) <- V.mask_vector beginning ending w.(i)
     done ;
     Half_full_matrix result
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_masked_vert_band beginning ending w )
 | Diff_to_scal_matrix ( y , w ) -> masked_vert_band beginning ending ( to_diff_to_diag m )
 | Diff_to_multi_scal_matrix ( y , w ) -> masked_vert_band beginning ending ( to_diff_to_multi_diag m )
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let b = Index.to_int beginning
   and e = Index.to_int ending
   and r = Array.length a in
    let aa = Array.map Coeff.zero ( Array.make r () ) in
     for i = max 0 b to min ( pred r ) e do
      aa.(i) <- a.(i)
     done ;
     Diff_to_diag_matrix ( aa , tensor_masked_vert_band beginning ending w )
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let b = Index.to_int beginning
   and e = Index.to_int ending
   and r = Array.length a
   and c = Array.length a.(0) in
    let aa = Array.map ( Array.map Coeff.zero ) ( Array.make_matrix r c () )
    and hr = r / 2
    and cc = pred c in
     for i = 0 to pred r do
      let output = aa.(i)
      and ii = i - hr
      and input = a.(i) in
       for j = max 0 ( b - ii ) to min cc ( e - ii ) do
        output.(j) <- input.(j)
       done ;
     done ;
     Diff_to_multi_diag_matrix ( aa , tensor_masked_vert_band beginning ending w )
  end ;;

(** 
masked_head vert_ending hor_ending matrix
*)

let rec masked_head = fun (vert_ending:index) (hor_ending:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let d = V.dimension w.(0)
   and r = Array.length w in
    let result = Array.map V.null ( Array.make r d ) in
     for i = 0 to min ( pred r ) ( Index.to_int vert_ending ) do
      result.(i) <- V.mask_vector ( Index.zero () ) hor_ending w.(i)
     done ;
     Half_full_matrix result
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_masked_head vert_ending hor_ending w )
 | Diff_to_scal_matrix ( y , w ) -> masked_head vert_ending hor_ending ( to_diff_to_diag m )
 | Diff_to_multi_scal_matrix ( y , w ) -> masked_head vert_ending hor_ending ( to_diff_to_multi_diag m )
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let v = Index.to_int vert_ending
   and h = Index.to_int hor_ending
   and r = Array.length a in
    let aa = Array.map Coeff.zero ( Array.make r () ) in
     for i = 0 to min ( pred r ) ( min v h ) do
      aa.(i) <- a.(i)
     done ;
     Diff_to_diag_matrix ( aa , tensor_masked_head vert_ending hor_ending w )
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let v = Index.to_int vert_ending
   and h = Index.to_int hor_ending
   and r = Array.length a
   and c = Array.length a.(0) in
    let aa = Array.map ( Array.map Coeff.zero ) ( Array.make_matrix r c () )
    and hr = r / 2
    and cc = pred c in
     let bound = min v cc in
      for i = 0 to pred r do
       let output = aa.(i)
       and ii = i - hr
       and input = a.(i) in
        for j = 0 to min bound ( h - ii ) do
         output.(j) <- input.(j)
        done ;
      done ;
      Diff_to_multi_diag_matrix ( aa , tensor_masked_head vert_ending hor_ending w )
  end ;;

(** 
masked_tail vert_beginning hor_beginning matrix
*)

let rec masked_tail = fun (vert_beginning:index) (hor_beginning:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let d = V.dimension w.(0)
   and r = Array.length w in
    let result = Array.map V.null ( Array.make r d ) in
     for i = max 0 ( Index.to_int vert_beginning ) to pred r do
      result.(i) <- V.mask_vector hor_beginning d w.(i)
     done ;
     Half_full_matrix result
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_masked_tail vert_beginning hor_beginning w )
 | Diff_to_scal_matrix ( y , w ) -> masked_tail vert_beginning hor_beginning ( to_diff_to_diag m )
 | Diff_to_multi_scal_matrix ( y , w ) -> masked_tail vert_beginning hor_beginning ( to_diff_to_multi_diag m )
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let v = Index.to_int vert_beginning
   and h = Index.to_int hor_beginning
   and r = Array.length a in
    let aa = Array.map Coeff.zero ( Array.make r () ) in
     for i = max v h to pred r do
      aa.(i) <- a.(i)
     done ;
     Diff_to_diag_matrix ( aa , tensor_masked_tail vert_beginning hor_beginning w )
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let v = Index.to_int vert_beginning
   and h = Index.to_int hor_beginning
   and r = Array.length a
   and c = Array.length a.(0) in
    let aa = Array.map ( Array.map Coeff.zero ) ( Array.make_matrix r c () )
    and hr = r / 2
    and cc = pred c in
     let bound = max 0 v in
      for i = 0 to pred r do
       let output = aa.(i)
       and ii = i - hr
       and input = a.(i) in
        for j = max bound ( h - ii ) to cc do
         output.(j) <- input.(j)
        done ;
      done ;
      Diff_to_multi_diag_matrix ( aa , tensor_masked_tail vert_beginning hor_beginning w )
  end ;;

(** 
masked_sample vert_beginning vert_ending hor_beginning hor_ending matrix
*)

let rec masked_sample = fun (vert_beginning:index) (vert_ending:index) (hor_beginning:index) (hor_ending:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let d = V.dimension w.(0)
   and r = Array.length w in
    let result = Array.map V.null ( Array.make r d ) in
     for i = max 0 ( Index.to_int vert_beginning ) to min ( pred r ) ( Index.to_int vert_ending ) do
      result.(i) <- V.mask_vector hor_beginning hor_ending w.(i)
     done ;
     Half_full_matrix result
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_masked_sample vert_beginning vert_ending hor_beginning hor_ending w )
 | Diff_to_scal_matrix ( y , w ) -> masked_sample vert_beginning vert_ending hor_beginning hor_ending ( to_diff_to_diag m )
 | Diff_to_multi_scal_matrix ( y , w ) -> masked_sample vert_beginning vert_ending hor_beginning hor_ending ( to_diff_to_multi_diag m )
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let vb = Index.to_int vert_beginning
   and hb = Index.to_int hor_beginning
   and ve = Index.to_int vert_ending
   and he = Index.to_int hor_ending
   and r = Array.length a in
    let aa = Array.map Coeff.zero ( Array.make r () ) in
     for i = max 0 ( max vb hb ) to min ( pred r ) ( min ve he ) do
      aa.(i) <- a.(i)
     done ;
     Diff_to_diag_matrix ( aa , tensor_masked_sample vert_beginning vert_ending hor_beginning hor_ending w )
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let vb = Index.to_int vert_beginning
   and hb = Index.to_int hor_beginning
   and ve = Index.to_int vert_ending
   and he = Index.to_int hor_ending
   and r = Array.length a
   and c = Array.length a.(0) in
    let aa = Array.map ( Array.map Coeff.zero ) ( Array.make_matrix r c () )
    and hr = r / 2
    and cc = pred c in
     let beginning = max 0 vb
     and ending = min ve cc in
      for i = 0 to pred r do
       let output = aa.(i)
       and ii = i - hr
       and input = a.(i) in
        for j = max beginning ( hb - ii ) to min ending ( he - ii ) do
         output.(j) <- input.(j)
        done ;
      done ;
      Diff_to_multi_diag_matrix ( aa , tensor_masked_sample vert_beginning vert_ending hor_beginning hor_ending w )
  end ;;

(** 
hor_band beginning ending matrix
*)

let rec hor_band = fun (beginning:index) (ending:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let d = V.dimension w.(0)
   and b = Index.to_int beginning
   and e = Index.to_int ending in
    let r = max 0 ( e - b ) in
     let result = Array.map V.null ( Array.make ( succ r ) d ) in
      for i = 0 to r do
       result.(i) <- w.( b + i)
      done ;
      Half_full_matrix result
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_hor_band beginning ending w )
 | Diff_to_scal_matrix ( y , w ) -> hor_band beginning ending ( to_half_full m )
 | Diff_to_multi_scal_matrix ( y , w ) -> hor_band beginning ending ( to_half_full m )
 | Diff_to_diag_matrix ( a , w ) -> hor_band beginning ending ( to_half_full m )
 | Diff_to_multi_diag_matrix ( a , w ) -> hor_band beginning ending ( to_half_full m ) ;;

(** 
vert_band beginning ending matrix
*)

let rec vert_band = fun (beginning:index) (ending:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let d = V.dimension w.(0)
   and r = Array.length w in
    let result = Array.map V.null ( Array.make r d ) in
     for i = 0 to pred r do
      result.(i) <- V.sub_vector beginning ending w.(i)
     done ;
     Half_full_matrix result
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_vert_band beginning ending w )
 | Diff_to_scal_matrix ( y , w ) -> vert_band beginning ending ( to_half_full m )
 | Diff_to_multi_scal_matrix ( y , w ) -> vert_band beginning ending ( to_half_full m )
 | Diff_to_diag_matrix ( a , w ) -> vert_band beginning ending ( to_half_full m )
 | Diff_to_multi_diag_matrix ( a , w ) -> vert_band beginning ending ( to_half_full m ) ;;

(** 
head vert_ending hor_ending matrix
*)

let rec head = fun (vert_ending:index) (hor_ending:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let ve = Index.to_int vert_ending in
    let result = Array.map V.null ( Array.make ( succ ve ) ( Index.succ hor_ending ) ) in
     for i = 0 to max 0 ve do
      result.(i) <- V.sub_vector ( Index.zero () ) hor_ending w.(i)
     done ;
     Half_full_matrix result
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_head vert_ending hor_ending w )
 | Diff_to_scal_matrix ( y , w ) -> Diff_to_scal_matrix ( y , tensor_head vert_ending hor_ending w )
 | Diff_to_multi_scal_matrix ( y , w ) -> Diff_to_multi_scal_matrix ( y , tensor_head vert_ending hor_ending w )
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   let v = Index.to_int vert_ending
   and h = Index.to_int hor_ending in
    let aa = Array.sub a 0 ( succ ( min v h ) ) in
      Diff_to_diag_matrix ( aa , tensor_head vert_ending hor_ending w )
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   let v = Index.to_int vert_ending in
    let aa = Array.map ( function b -> Array.sub b 0 ( succ v ) ) a in
     Diff_to_multi_diag_matrix ( aa , tensor_head vert_ending hor_ending w )
  end ;;

(** 
tail vert_beginning hor_beginning matrix
*)

let rec tail = fun (vert_beginning:index) (hor_beginning:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let vb = Index.to_int vert_beginning
   and d = V.dimension w.(0)
   and r = Array.length w in
    let rr = max 0 ( r - vb )
    and dd = Index.pred d in
     let result = Array.map V.null ( Array.make rr ( Index.sub d hor_beginning ) ) in
      for i = 0 to pred rr do
       result.(i) <- V.sub_vector hor_beginning dd w.( vb + i )
      done ;
      Half_full_matrix result
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_tail vert_beginning hor_beginning w )
 | Diff_to_scal_matrix ( y , w ) ->
  begin
   if Index.eq vert_beginning hor_beginning then
    Diff_to_scal_matrix ( y , tensor_tail vert_beginning hor_beginning w )
   else
    tail vert_beginning hor_beginning ( to_half_full m )
  end
 | Diff_to_multi_scal_matrix ( y , w ) ->
  begin
   if Index.eq vert_beginning hor_beginning then
    Diff_to_multi_scal_matrix ( y , tensor_tail vert_beginning hor_beginning w )
   else
    tail vert_beginning hor_beginning ( to_half_full m )
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   if Index.eq vert_beginning hor_beginning then
    begin
     let v = Index.to_int vert_beginning
     and h = Index.to_int hor_beginning in
      let aa = Util.array_end ( min v h ) a in
        Diff_to_diag_matrix ( aa , tensor_tail vert_beginning hor_beginning w )
    end
   else
    tail vert_beginning hor_beginning ( to_half_full m )
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   if Index.eq vert_beginning hor_beginning then
    begin
     let v = Index.to_int vert_beginning in
      let aa = Array.map ( Util.array_end ( max 0 v ) ) a in
       Diff_to_multi_diag_matrix ( aa , tensor_head vert_beginning hor_beginning w )
    end
   else
    tail vert_beginning hor_beginning ( to_half_full m )
  end ;;

(** 
sample vert_beginning vert_ending hor_beginning hor_ending matrix
*)

let rec sample = fun (vert_beginning:index) (vert_ending:index) (hor_beginning:index) (hor_ending:index) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let d = Index.succ ( Index.sub hor_ending hor_beginning )
   and b = Index.to_int vert_beginning
   and rr = Index.to_int ( Index.sub vert_ending vert_beginning ) in
    let result = Array.map V.null ( Array.make ( succ rr ) d ) in
     for i = 0 to rr do
      result.(i) <- V.sub_vector hor_beginning hor_ending w.( b + i )
     done ;
     Half_full_matrix result
  end
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( tensor_sample vert_beginning vert_ending hor_beginning hor_ending w )
 | Diff_to_scal_matrix ( y , w ) ->
  begin
   if Index.eq vert_beginning hor_beginning then
    Diff_to_scal_matrix ( y , tensor_sample vert_beginning vert_ending hor_beginning hor_ending w )
   else
    sample vert_beginning vert_ending hor_beginning hor_ending ( to_half_full m )
  end
 | Diff_to_multi_scal_matrix ( y , w ) ->
  begin
   if Index.eq vert_beginning hor_beginning then
    Diff_to_multi_scal_matrix ( y , tensor_sample vert_beginning vert_ending hor_beginning hor_ending w )
   else
    sample vert_beginning vert_ending hor_beginning hor_ending ( to_half_full m )
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   if Index.eq vert_beginning hor_beginning then
    begin
     let vb = Index.to_int vert_beginning
     and ve = Index.to_int vert_ending
     and he = Index.to_int hor_ending in
      let aa = Array.sub a vb ( ( min ve he ) - vb + 1 ) in
       Diff_to_diag_matrix ( aa , tensor_sample vert_beginning vert_ending hor_beginning hor_ending w )
    end
   else
    sample vert_beginning vert_ending hor_beginning hor_ending ( to_half_full m )
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   if Index.eq vert_beginning hor_beginning then
    begin
     let vb = Index.to_int vert_beginning
     and ve = Index.to_int vert_ending in
      let cc = ve - vb in
       let c = succ cc in
        let aa = Array.map ( function table -> Array.sub table vb c ) a in
         Diff_to_multi_diag_matrix ( aa , tensor_sample vert_beginning vert_ending hor_beginning hor_ending w )
    end
   else
    sample vert_beginning vert_ending hor_beginning hor_ending ( to_half_full m )
  end ;;

(** 
iter function matrix
*)

let rec iter = fun f (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let r = Array.length w in
    for i = 0 to pred r do
     V.iter ( function ( j , x ) -> f ( [| ( Index.from_int i ) ; j |] , x ) ) w.(i)
    done ;
  end
 | Sparse_tensor_matrix w -> T.iter f w
 |  _ -> iter f ( to_sparse_tensor m ) ;;


(** 
row_exchange index1 index2 matrix
This function is applied in place.

Cette fonction est exécutée en place.*)


let row_exchange = fun (i:index) (j:index) (m:t) ->
 if not ( Index.eq i j ) then
  begin
   match m with
   | Half_full_matrix w ->
    begin
     let ii = Index.to_int i
     and jj = Index.to_int j in
      let accu = w.(ii) in
       w.(ii) <- w.(jj) ;
       w.(jj) <- accu
    end
   | Sparse_tensor_matrix w -> T.exchange 0 i j w
   | Diff_to_scal_matrix ( y , w ) ->
    begin
     let ii = Array.make 2 i
     and jj = Array.make 2 j in
      T.exchange 0 i j w ;
      T.insert_sub y ii w ;
      T.insert_sub y jj w ;
      T.insert_add y [| i ; j |] w ;
      T.insert_add y [| j ; i |] w ;
    end
   | Diff_to_multi_scal_matrix ( a , w ) ->
    begin
     let alength = Array.length a
     and d = T.dimensions w
     and ii = Index.to_int i
     and jj = Index.to_int j in
      T.exchange 0 i j w ;
      let h_a_l = alength / 2
      and c = Index.to_int d.(1) in
       let shift_i = ii - h_a_l
       and shift_j = jj - h_a_l in
        for k = 0 to pred alength do
         let aa = a.(k)
         and ki = shift_i + k
         and kj = shift_j + k in
          let k_i = Index.from_int ki
          and k_j = Index.from_int kj in
           if ( ki >= 0 ) && ( ki < c ) then
            begin
             T.insert_add aa [| j ; k_i |] w ;
             T.insert_sub aa [| i ; k_i |] w
            end ;
           if ( kj >= 0 ) && ( kj < c ) then
            begin
             T.insert_add aa [| i ; k_j |] w ;
             T.insert_sub aa [| j ; k_j |] w
            end ;
        done ;
    end
   | Diff_to_diag_matrix ( a , w ) ->
    begin
     let ii = Array.make 2 i
     and jj = Array.make 2 j
     and i_i = Index.to_int i
     and j_j = Index.to_int j in
      T.exchange 0 i j w ;
      let ai = a.(i_i)
      and aj = a.(j_j) in
       T.insert_sub ai ii w ;
       T.insert_sub aj jj w ;
       T.insert_add aj [| i ; j |] w ;
       T.insert_add ai [| j ; i |] w ;
    end
   | Diff_to_multi_diag_matrix ( a , w ) ->
    begin
     let alength = Array.length a
     and d = T.dimensions w
     and ii = Index.to_int i
     and jj = Index.to_int j in
      T.exchange 0 i j w ;
      let h_a_l = alength / 2
      and c = Index.to_int d.(1) in
       let shift_i = ii - h_a_l
       and shift_j = jj - h_a_l in
        for k = 0 to pred alength do
         let aa = a.(k)
         and ki = shift_i + k
         and kj = shift_j + k in
          let k_i = Index.from_int ki
          and k_j = Index.from_int kj
          and ai = aa.(ii)
          and aj = aa.(jj) in
           if ( ki >= 0 ) && ( ki < c ) then
            begin
             T.insert_add ai [| j ; k_i |] w ;
             T.insert_sub ai [| i ; k_i |] w
            end ;
           if ( kj >= 0 ) && ( kj < c ) then
            begin
             T.insert_add aj [| i ; k_j |] w ;
             T.insert_sub aj [| j ; k_j |] w
            end ;
        done ;
    end
  end ;;


(** 
column_exchange index1 index2 matrix
This function is applied in place.

Cette fonction est exécutée en place. *)


let column_exchange = fun (i:index) (j:index) (m:t) ->
 if not ( Index.eq i j ) then
  begin
   match m with
   | Half_full_matrix w ->
    begin
     for k = 0 to pred ( Array.length w ) do
      V.exchange i j w.(k)
     done ;
    end
   | Sparse_tensor_matrix w -> T.exchange 1 i j w
   | Diff_to_scal_matrix ( y , w ) ->
    begin
     let ii = Array.make 2 i
     and jj = Array.make 2 j in
      T.exchange 1 i j w ;
      T.insert_sub y ii w ;
      T.insert_sub y jj w ;
      T.insert_add y [| i ; j |] w ;
      T.insert_add y [| j ; i |] w ;
    end
   | Diff_to_diag_matrix ( a , w ) ->
    begin
     let ii = Array.make 2 i
     and jj = Array.make 2 j
     and i_i = Index.to_int i
     and j_j = Index.to_int j in
      T.exchange 1 i j w ;
      let ai = a.(i_i)
      and aj = a.(j_j) in
       T.insert_sub ai ii w ;
       T.insert_sub aj jj w ;
       T.insert_add ai [| i ; j |] w ;
       T.insert_add aj [| j ; i |] w ;
    end
   | _ ->
    begin
     let ci = column_extract i m
     and cj = column_extract j m in
      column_replace ci j m ;
      column_replace cj i m ;
    end
  end ;;

(** 
in_place_map function matrix
*)

let in_place_map = fun f (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> T.in_place_map f w
 | Diff_to_scal_matrix ( x , w ) -> failwith "Diff_to_scal matrix in Sparse_matrix.Rng.in_place_map."
 | Diff_to_multi_scal_matrix ( a , w ) ->
  begin
   for i = 0 to pred ( Array.length a ) do
    a.(i) <- f a.(i)
   done ;
   T.in_place_map f w
  end
 | Half_full_matrix w ->
  begin
   for i = 0 to pred ( Array.length w ) do
    V.in_place_map f w.(i)
   done ;
  end
 | Diff_to_diag_matrix ( a , w ) ->
  begin
   for i = 0 to pred ( Array.length a ) do
    a.(i) <- f a.(i)
   done ;
   T.in_place_map f w
  end
 | Diff_to_multi_diag_matrix ( a , w ) ->
  begin
   for i = 0 to pred ( Array.length a ) do
    a.(i) <- Array.map f a.(i)
   done ;
   T.in_place_map f w
  end ;;

(** 
map function matrix
*)

let map = fun f (m:t) ->
 match m with
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( T.map f w )
 | Diff_to_scal_matrix ( x , w ) -> Diff_to_scal_matrix ( f x , T.map f w )
 | Diff_to_multi_scal_matrix ( a , w ) -> Diff_to_multi_scal_matrix ( Array.map f a , T.map f w )
 | Half_full_matrix w -> Half_full_matrix ( Array.map ( V.map f ) w )
 | Diff_to_diag_matrix ( a , w ) -> Diff_to_diag_matrix ( Array.map f a , T.map f w )
 | Diff_to_multi_diag_matrix ( a , w ) -> Diff_to_multi_diag_matrix ( Array.map ( Array.map f ) a , T.map f w ) ;;

(** 
in_place_opp matrix
*)

let in_place_opp = function (m:t) ->
 in_place_map Coeff.opp m ;;

(** 
opp matrix
*)

let opp = function (m:t) ->
 map Coeff.opp m ;;

(** 
embed dimensions shifts matrix
*)

let rec embed = fun (dim:index array) (shifts:index array) (m:t) ->
 let d = dimensions m
 and s0 = shifts.(0)
 and s1 = shifts.(1)
 and r = dim.(0)
 and c = dim.(1) in
  let e0 = Index.add s0 d.(0)
  and e1 = Index.add s1 d.(1) in
  assert ( ( Index.compare r e0 >= 0 ) && ( Index.compare c e1 >= 0 ) ) ;
  match m with
  | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( T.embed dim shifts w )
  | Diff_to_scal_matrix ( x , w ) -> embed dim shifts ( to_half_full m )
  | Diff_to_multi_scal_matrix ( a , w ) -> embed dim shifts ( to_half_full m )
  | Half_full_matrix w ->
   begin
    let c = dim.(1)
    and s_0 = Index.to_int s0 in
     let ww = Array.map V.null ( Array.make ( Index.to_int r ) c ) in
      for i = 0 to pred ( Array.length w ) do
       ww.( s_0 + i ) <- V.embed c s1 w.(i)
      done ;
      Half_full_matrix ( ww )
   end
  | Diff_to_diag_matrix ( a , w ) ->
   begin
    if Index.eq s0 s1 then
     begin
      let rest = Index.min ( Index.sub r e0 ) ( Index.sub c e1 ) in
       let aa = Array.concat [ Array.map Coeff.zero ( Array.make ( Index.to_int s0 ) () ) ; a ; Array.map Coeff.zero ( Array.make ( Index.to_int rest ) () ) ] in
        Diff_to_diag_matrix ( aa , T.embed dim shifts w )
     end
    else
     embed dim shifts ( to_half_full m )
   end
  | Diff_to_multi_diag_matrix ( a , w ) ->
   begin
    if Index.eq s0 s1 then
     begin
      let rest = Index.min ( Index.sub r e0 ) ( Index.sub c e1 ) in
       let f = function b -> Array.concat [ Array.map Coeff.zero ( Array.make ( Index.to_int s0 ) () ) ; b ; Array.map Coeff.zero ( Array.make ( Index.to_int rest ) () ) ] in
        Diff_to_multi_diag_matrix ( Array.map f a , T.embed dim shifts w )
     end
    else
     embed dim shifts ( to_half_full m )
   end ;;

(** 
sparse_tensor_dirty_rows_list tensor
*)

let sparse_tensor_dirty_rows_list = function (w:T.t) ->
 let ( e , t , v ) = T.flat_tensor_demakeup w
 and result = ref [] in
  let rows = t.(0) in
   let f = function ( index , coefficient ) -> result := index :: !result in
    T.Info.iter f rows ;
    !result ;;

(** 
sparse_tensor_dirty_columns_list tensor
*)

let sparse_tensor_dirty_columns_list = function (w:T.t) ->
 let ( e , t , v ) = T.flat_tensor_demakeup w
 and result = ref [] in
  let columns = t.(1) in
   let f = function ( index , coefficient ) -> result := index :: !result in
    T.Info.iter f columns ;
    !result ;;

(** 
sparse_tensor_dirty_rows_array tensor
*)

let sparse_tensor_dirty_rows_array = function (w:T.t) ->
 Array.of_list ( sparse_tensor_dirty_rows_list w ) ;;
 
(** 
sparse_tensor_dirty_columns_array tensor
*)

let sparse_tensor_dirty_columns_array = function (w:T.t) ->
 Array.of_list ( sparse_tensor_dirty_columns_list w ) ;;




(**
§
*)

(**

Opérations de calcul

Calculative operations

 *)

(**
*)





(** 
sparse_row_fold function init matrix
*)

let rec sparse_row_fold = fun (f:coeff -> V.t -> coeff) (init:V.t) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let ff = fun i x -> f ( V.raw_extract ( Index.from_int i ) init ) x in
    V.to_sparse ( V.size init ) ( Array.mapi ff w )
  end
 | Sparse_tensor_matrix w ->
  begin
   let accu = ref ( V.H.B.E.empty )
   and result = V.null ( V.dimension init ) in
    let ff = function ( i , x ) -> accu := V.H.B.E.add ( i.(0) , Coeff.zero () ) !accu
    and g = function ( i , x ) ->
     begin
      let y = V.raw_extract i init
      and row = tensor_row_extract i w in
       V.insert_add ( f y row ) i result ;
     end in
     T.iter ff w ;
     V.H.B.E.iter g !accu ;
     result
  end
 | _ -> sparse_row_fold f init ( to_half_full m ) ;;

(** 
sparse_column_fold function init matrix
*)

let rec sparse_column_fold = fun (f:coeff -> V.t -> coeff) (init:V.t) (m:t) ->
 match m with
 | Sparse_tensor_matrix w ->
  begin
   let accu = ref ( V.H.B.E.empty )
   and result = V.null ( V.dimension init ) in
    let ff = function ( i , x ) -> accu := V.H.B.E.add ( i.(1) , Coeff.zero () ) !accu
    and g = function ( i , x ) ->
     begin
      let y = V.raw_extract i init
      and column = tensor_column_extract i w in
       V.insert_add ( f y column ) i result ;
     end in
     T.iter ff w ;
     V.H.B.E.iter g !accu ;
     result
  end
 | _ -> sparse_column_fold f init ( to_sparse_tensor m ) ;;

(** 
full_row_fold function matrix init
*)

let rec full_row_fold = fun (f:coeff -> V.t -> coeff) (init:coeff array) (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   let ff = fun i x -> f init.(i) x in
    Array.mapi ff w
  end
 | Sparse_tensor_matrix w ->
  begin
   let accu = ref ( V.H.B.E.empty )
   and r = Array.length init in
    let result = Array.map Coeff.zero ( Array.make r () )
    and ff = function ( i , x ) -> accu := V.H.B.E.add ( i.(0) , Coeff.zero () ) !accu in
     let g = function ( i , x ) ->
      begin
       let ii = Index.to_int i
       and row = tensor_row_extract i w in
        result.(ii) <- f init.(ii) row ;
      end in
      T.iter ff w ;
      V.H.B.E.iter g !accu ;
      result
  end
 | _ -> full_row_fold f init ( to_half_full m ) ;;

(** 
full_column_fold function init matrix
*)

let rec full_column_fold = fun (f:coeff -> V.t -> coeff) (init:coeff array) (m:t) ->
 match m with
 | Sparse_tensor_matrix w ->
  begin
   let accu = ref ( V.H.B.E.empty )
   and r = Array.length init in
    let result = Array.map Coeff.zero ( Array.make r () )
    and ff = function ( i , x ) -> accu := V.H.B.E.add ( i.(1) , Coeff.zero () ) !accu in
     let g = function ( i , x ) ->
      begin
       let ii = Index.to_int i
       and column = tensor_column_extract i w in
        result.(ii) <- f init.(ii) column ;
      end in
      T.iter ff w ;
      V.H.B.E.iter g !accu ;
      result
  end
 | _ -> full_column_fold f init ( to_sparse_tensor m ) ;;

(** 
sparse_row_sum matrix
*)

let sparse_row_sum = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.sum v in
  sparse_row_fold f ( V.null d.(0) ) m ;;

(** 
sparse_column_sum matrix
*)

let sparse_column_sum = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.sum v in
  sparse_column_fold f ( V.null d.(1) ) m ;;

(** 
full_row_sum matrix
*)

let full_row_sum = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.sum v in
  let z = Array.map Coeff.zero ( Array.make ( Index.to_int d.(0) ) () ) in
   full_row_fold f z m ;;

(** 
full_column_sum matrix
*)

let full_column_sum = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.sum v in
  let z = Array.map Coeff.zero ( Array.make ( Index.to_int d.(1) ) () ) in
   full_column_fold f z m ;;

(** 
sparse_matrix_sum matrix
*)

let sparse_matrix_sum = function (m:t) ->
 let v = sparse_row_sum m in
  V.sum v ;;

(** 
full_matrix_sum matrix
*)

let full_matrix_sum = function (m:t) ->
 let v = full_row_sum m in
  Array.fold_left Coeff.add ( Coeff.zero () ) v ;;

(** 
matrix_sparse_vector_sparse_prod matrix vector
*)

let matrix_sparse_vector_sparse_prod = fun (m:t) (v:V.t) ->
 let d = dimensions m
 and f = fun x w -> V.scal_prod v w in
  let z = V.null d.(0) in
   sparse_row_fold f z m ;;

(** 
matrix_full_vector_sparse_prod matrix vector
*)

let matrix_full_vector_sparse_prod = fun (m:t) (v:coeff array) ->
 let d = dimensions m in
  let f = fun x w -> V.sparse_full_scal_prod w v
  and z = V.null d.(0) in
   sparse_row_fold f z m ;;

(** 
matrix_sparse_vector_full_prod matrix vector
*)

let matrix_sparse_vector_full_prod = fun (m:t) (v:V.t) ->
 let d = dimensions m
 and f = fun x w -> V.scal_prod v w in
  let z = Array.map Coeff.zero ( Array.make ( Index.to_int d.(0) ) () ) in
   full_row_fold f z m ;;

(** 
matrix_full_vector_full_prod matrix vector
*)

let matrix_full_vector_full_prod = fun (m:t) (v:coeff array) ->
 let d = dimensions m in
  let f = fun x w -> V.sparse_full_scal_prod w v
  and z = Array.map Coeff.zero ( Array.make ( Index.to_int d.(0) ) () ) in
   full_row_fold f z m ;;

(** 
sparse_vector_matrix_sparse_prod vector matrix
*)

let sparse_vector_matrix_sparse_prod = fun (v:V.t) (m:t) ->
 let d = dimensions m
 and f = fun x w -> V.scal_prod v w in
  let z = V.null d.(1) in
   sparse_column_fold f z m ;;

(** 
full_vector_matrix_sparse_prod vector matrix
*)

let full_vector_matrix_sparse_prod = fun (v:coeff array) (m:t) ->
 let d = dimensions m in
  let f = fun x w -> V.sparse_full_scal_prod w v
  and z = V.null d.(1) in
   sparse_column_fold f z m ;;

(** 
sparse_vector_matrix_full_prod vector matrix
*)

let sparse_vector_matrix_full_prod = fun (v:V.t) (m:t) ->
 let d = dimensions m
 and f = fun x w -> V.scal_prod v w in
  let z = Array.map Coeff.zero ( Array.make ( Index.to_int d.(1) ) () ) in
   full_column_fold f z m ;;

(** 
full_vector_matrix_full_prod vector matrix
*)

let full_vector_matrix_full_prod = fun (v:coeff array) (m:t) ->
 let d = dimensions m in
  let f = fun x w -> V.sparse_full_scal_prod w v
  and z = Array.map Coeff.zero ( Array.make ( Index.to_int d.(1) ) () ) in
   full_column_fold f z m ;;

(** 
sparse_row_max matrix
*)

let sparse_row_max = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.max v in
  sparse_row_fold f ( V.null d.(0) ) m ;;

(** 
sparse_column_max matrix
*)

let sparse_column_max = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.max v in
  sparse_column_fold f ( V.null d.(1) ) m ;;

(** 
full_row_max matrix
*)

let full_row_max = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.max v in
  let z = Array.map Coeff.zero ( Array.make ( Index.to_int d.(0) ) () ) in
   full_row_fold f z m ;;

(** 
full_column_max matrix
*)

let full_column_max = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.max v in
  let z = Array.map Coeff.zero ( Array.make ( Index.to_int d.(1) ) () ) in
   full_column_fold f z m ;;

(** 
sparse_matrix_max matrix
*)

let sparse_matrix_max = function (m:t) ->
 let v = sparse_row_max m in
  V.max v ;;

(** 
full_matrix_max matrix
*)

let full_matrix_max = function (m:t) ->
 let v = full_row_max m in
  Array.fold_left Coeff.add ( Coeff.zero () ) v ;;

(** 
sparse_row_min matrix
*)

let sparse_row_min = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.min v in
  sparse_row_fold f ( V.null d.(0) ) m ;;

(** 
sparse_column_min matrix
*)

let sparse_column_min = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.min v in
  sparse_column_fold f ( V.null d.(1) ) m ;;

(** 
full_row_min matrix
*)

let full_row_min = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.min v in
  let z = Array.map Coeff.zero ( Array.make ( Index.to_int d.(0) ) () ) in
   full_row_fold f z m ;;

(** 
full_column_min matrix
*)

let full_column_min = function (m:t) ->
 let d = dimensions m
 and f = fun x v -> V.min v in
  let z = Array.map Coeff.zero ( Array.make ( Index.to_int d.(1) ) () ) in
   full_column_fold f z m ;;

(** 
sparse_matrix_min matrix
*)

let sparse_matrix_min = function (m:t) ->
 let v = sparse_row_min m in
  V.min v ;;

(** 
full_matrix_min matrix
*)

let full_matrix_min = function (m:t) ->
 let v = full_row_min m in
  Array.fold_left Coeff.add ( Coeff.zero () ) v ;;

(** 
norm_inf matrix
*)

let rec norm_inf = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   Util.array_maximum Coeff.norm_compare ( Array.map V.norm_1 w )
  end
 | Sparse_tensor_matrix w ->
  begin
   let accu = ref ( V.H.B.E.empty )
   and result = ref ( Coeff.norm_zero () )
   and accumulator = ref [] in
    let ff = function ( i , x ) -> accu := V.H.B.E.add ( i.(0) , Coeff.zero () ) !accu
    and g = function ( i , x ) ->
     begin
      let row = tensor_row_extract i w in
       accumulator := ( V.norm_1 row ) :: !accumulator ;
     end in
     T.iter ff w ;
     V.H.B.E.iter g !accu ;
     while Util.list_non_empty !accumulator do
      let test = List.hd !accumulator in
       if Coeff.norm_compare test !result > 0 then
        result := test ;
       accumulator := List.tl !accumulator ;
     done ;
     !result
  end
 | _ -> norm_inf ( to_half_full m ) ;;

(** 
norm_1 matrix
*)

let rec norm_1 = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   Array.fold_left Coeff.norm_add ( Coeff.norm_zero () ) ( Array.map V.norm_inf w )
  end
 | Sparse_tensor_matrix w ->
  begin
   let accu = ref ( V.H.B.E.empty )
   and result = ref ( Coeff.norm_zero () )
   and accumulator = ref [] in
    let ff = function ( i , x ) -> accu := V.H.B.E.add ( i.(0) , Coeff.zero () ) !accu
    and g = function ( i , x ) ->
     begin
      let row = tensor_row_extract i w in
       accumulator := ( V.norm_inf row ) :: !accumulator ;
     end in
     T.iter ff w ;
     V.H.B.E.iter g !accu ;
     while Util.list_non_empty !accumulator do
      let test = List.hd !accumulator in
       result := Coeff.norm_add test !result ;
       accumulator := List.tl !accumulator ;
     done ;
     !result
  end
 | _ -> norm_1 ( to_half_full m ) ;;

(** 
square_norm_frobenius matrix
*)

let rec square_norm_frobenius = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   Array.fold_left Coeff.norm_add ( Coeff.norm_zero () ) ( Array.map V.square_norm_2 w )
  end
 | Sparse_tensor_matrix w ->
  begin
   let result = ref ( Coeff.norm_zero () ) in
    let f = function ( i , x ) ->
     begin
      let y = Coeff.norm x in
       result := Coeff.norm_add !result ( Coeff.norm_mult y y )
     end in
     T.iter f w ;
     !result
  end
 | _ -> square_norm_frobenius ( to_half_full m ) ;;

(** 
norm_sum matrix
*)

let rec norm_sum = function (m:t) ->
 match m with
 | Half_full_matrix w ->
  begin
   Array.fold_left Coeff.norm_add ( Coeff.norm_zero () ) ( Array.map V.norm_1 w )
  end
 | Sparse_tensor_matrix w ->
  begin
   let result = ref ( Coeff.norm_zero () ) in
    let f = function ( i , x ) ->
     begin
      let y = Coeff.norm x in
       result := Coeff.norm_add !result y
     end in
     T.iter f w ;
     !result
  end
 | _ -> norm_sum ( to_half_full m ) ;;

(** 
sparse_trace matrix
*)

let sparse_trace = function (m:t) ->
 let d = sparse_diag_extract m in
  V.sum d ;;

(** 
full_trace matrix
*)

let full_trace = function (m:t) ->
 let d = full_diag_extract m in
  Array.fold_left Coeff.add ( Coeff.zero () ) d ;;

(** 
trace matrix
*)

let trace = function (m:t) ->
 try
  sparse_trace m
 with _ ->
  full_trace m ;;

(** 
scal_mult coefficient matrix
*)

let scal_mult = fun (x:coeff) (m:t) ->
 match m with
 | Half_full_matrix w -> Half_full_matrix ( Array.map ( V.scal_mult x ) w )
 | Sparse_tensor_matrix w -> Sparse_tensor_matrix ( T.scal_mult x w )
 | Diff_to_scal_matrix ( y , w ) -> Diff_to_scal_matrix ( Coeff.mult x y , T.scal_mult x w ) 
 | Diff_to_multi_scal_matrix ( y , w ) -> Diff_to_multi_scal_matrix ( Array.map ( Coeff.mult x ) y , T.scal_mult x w )
 | Diff_to_diag_matrix ( a , w ) -> Diff_to_diag_matrix ( Array.map ( Coeff.mult x ) a , T.scal_mult x w ) 
 | Diff_to_multi_diag_matrix ( a , w ) -> Diff_to_multi_diag_matrix ( Array.map ( Array.map ( Coeff.mult x ) ) a , T.scal_mult x w ) ;;

(** 
add matrix1 matrix2
*)

let rec add = fun (m:t) (n:t) ->
 let test = ( description_eq_zero m , description_eq_zero n )
 and d = dimensions m in
  match test with
  | ( true , _ ) -> copy n
  | ( false , true ) -> copy m
  | _ ->
   begin
    match m with
    | Half_full_matrix w ->
     begin
      match n with
      | Half_full_matrix ww ->
       begin
        let r = Array.length w in
         let result = Array.map V.null ( Array.make r d.(1) ) in
          for i = 0 to pred r do
           result.(i) <- V.add w.(i) ww.(i)
          done ;
          Half_full_matrix result
       end
      | _ -> add m ( to_half_full n )
     end
    | Sparse_tensor_matrix w ->
     begin
      match n with
      | Half_full_matrix ww -> add n m
      | Sparse_tensor_matrix ww -> Sparse_tensor_matrix ( T.add w ww )
      | Diff_to_scal_matrix ( yy , ww ) -> Diff_to_scal_matrix ( Coeff.copy yy , T.add w ww )
      | Diff_to_multi_scal_matrix ( aa , ww ) -> Diff_to_multi_scal_matrix ( Array.map Coeff.copy aa , T.add w ww )
      | Diff_to_diag_matrix ( aa , ww ) -> Diff_to_diag_matrix ( Array.map Coeff.copy aa , T.add w ww )
      | Diff_to_multi_diag_matrix ( aa , ww ) -> Diff_to_multi_diag_matrix ( Array.map ( Array.map Coeff.copy ) aa , T.add w ww )
     end
    | Diff_to_scal_matrix ( y , w ) ->
     begin
      match n with
      | Half_full_matrix ww -> add n m
      | Sparse_tensor_matrix ww -> add n m
      | Diff_to_scal_matrix ( yy , ww ) -> Diff_to_scal_matrix ( Coeff.add y yy , T.add w ww )
      | Diff_to_multi_scal_matrix ( aa , ww ) ->
       begin
        let b = Array.map Coeff.copy aa
        and aalength = Array.length aa in
         b.( aalength / 2 ) <- Coeff.add b.( aalength / 2 ) y ;
         Diff_to_multi_scal_matrix ( b , T.add w ww )
       end
      | Diff_to_diag_matrix ( aa , ww ) ->
       begin
        let b = Array.map ( Coeff.add y ) aa in
         Diff_to_diag_matrix ( b , T.add w ww )
       end
      | Diff_to_multi_diag_matrix ( aa , ww ) ->
       begin
        let b = Array.map ( Array.map Coeff.copy ) aa
        and aalength = Array.length aa in
         b.( aalength / 2 ) <- Array.map ( Coeff.add y ) b.( aalength / 2 ) ;
         Diff_to_multi_diag_matrix ( b , T.add w ww )
       end
     end
    | Diff_to_multi_scal_matrix ( a , w ) ->
     begin
      match n with
      | Half_full_matrix ww -> add n m
      | Sparse_tensor_matrix ww -> add n m
      | Diff_to_scal_matrix ( yy , ww ) -> add n m
      | Diff_to_multi_scal_matrix ( aa , ww ) ->
       begin
        let b = Util.array_center_add Coeff.copy Coeff.add a aa in
         Diff_to_multi_scal_matrix ( b , T.add w ww )
       end
      | _ -> add ( to_half_full m ) ( to_half_full n )
     end
    | Diff_to_diag_matrix ( a , w ) ->
     begin
      match n with
      | Half_full_matrix ww -> add n m
      | Sparse_tensor_matrix ww -> add n m
      | Diff_to_scal_matrix ( yy , ww ) -> add n m
      | Diff_to_multi_scal_matrix ( aa , ww ) -> add n m
      | Diff_to_diag_matrix ( aa , ww ) ->
       begin
        let b = Util.array_map2 Coeff.add a aa in
         Diff_to_diag_matrix ( b , T.add w ww )
       end
      | Diff_to_multi_diag_matrix ( aa , ww ) ->
       begin
        let b = Util.array_center_add ( Array.map Coeff.copy ) ( Util.array_map2 Coeff.add ) [| a |] aa in
         Diff_to_multi_diag_matrix ( b , T.add w ww )
       end
     end
    | Diff_to_multi_diag_matrix ( a , w ) ->
     begin
      match n with
      | Half_full_matrix ww -> add n m
      | Sparse_tensor_matrix ww -> add n m
      | Diff_to_scal_matrix ( yy , ww ) -> add n m
      | Diff_to_multi_scal_matrix ( aa , ww ) -> add n m
      | Diff_to_diag_matrix ( aa , ww ) -> add n m
      | Diff_to_multi_diag_matrix ( aa , ww ) ->
       begin
        let b = Util.array_center_add ( Array.map Coeff.copy ) ( Util.array_map2 Coeff.add ) a aa in
         Diff_to_multi_diag_matrix ( b , T.add w ww )
       end
     end
   end ;;

(** 
sub matrix1 matrix2
*)

let sub = fun (m:t) (n:t) ->
 add m ( opp n ) ;;

(** 
eq matrix1 matrix2
*)

let eq = fun (m:t) (n:t) ->
 eq_zero ( sub m n ) ;;

(** 
twisted_mult matrix1 matrix2
*)

let rec twisted_mult = fun (m:t) (n:t) ->
 let dm = dimensions m
 and dn = dimensions n
 and test = ( description_eq_zero m , description_eq_zero n ) in
  let dm0 = dm.(0)
  and dm1 = dm.(1)
  and dn0 = dn.(0)
  and dn1 = dn.(1) in
   if not ( Index.eq dm1 dn1 ) then
    failwith "Bad dimensions in Sparse_matrix.Rng.twisted_mult." ;
   match test with
   | ( true , _ ) | ( false , true ) -> null [| dm0 ; dn0 |]
   | _ ->
    begin
     match m with
     | Half_full_matrix w  ->
      begin
       match n with
       | Half_full_matrix ww  ->
        begin
         let r = Index.to_int dm0 in
          let result = Array.map V.null ( Array.make r dn0 )
          and rr = pred r in
           for i = 0 to rr do
            let row_output = result.(i)
            and row_input_left = w.(i) in
             for j = 0 to rr do
              V.insert_add ( V.scal_prod row_input_left ww.(j) ) ( Index.from_int j ) row_output
             done ;
           done ;
           Half_full_matrix result
        end
       | Sparse_tensor_matrix ww ->
        begin
         let r = Index.to_int dm0 in
          let result = Array.map V.null ( Array.make r dn0 ) in
           let f = fun row_input_left row_output ( a , y ) ->
            begin
             let j = a.(0)
             and k = a.(1) in
              V.insert_add ( Coeff.mult ( V.raw_extract k row_input_left ) y ) j row_output
            end in
            for i = 0 to pred r do
             T.iter ( f w.(i) result.(i) ) ww ;
            done ;
            Half_full_matrix result
        end
       | Diff_to_scal_matrix ( xx , ww ) ->
        begin
         if Index.eq dn0 dn1 then
          add ( scal_mult xx m ) ( twisted_mult m ( Sparse_tensor_matrix ww ) )
         else
          twisted_mult m ( to_half_full n )
        end
       | _ -> twisted_mult m ( to_half_full n )
      end
     | Sparse_tensor_matrix w ->
      begin
       match n with
       | Half_full_matrix ww  ->
        begin
         let r = Index.to_int dn0 in
          let result = T.null [| dm0 ; dn0 |] in
           let f = fun j row_input_right ( a , y ) ->
            begin
             let i = a.(0)
             and k = a.(1) in
              T.insert_add ( Coeff.mult ( V.raw_extract k row_input_right ) y ) [| i ; j |] result
            end in
            for j = 0 to pred r do
             T.iter ( f ( Index.from_int j ) ww.(j) ) w ;
            done ;
            Sparse_tensor_matrix result
        end
       | Sparse_tensor_matrix ww ->
        begin
         let result = T.null [| dm0 ; dn0 |]
         and rows = sparse_tensor_dirty_rows_array w
         and columns = sparse_tensor_dirty_rows_array ww in
          let r = Array.length rows
          and c = Array.length columns in
           let dirty_right = Array.make c ( V.null dn1 )
           and cc = pred c in
            for i = 0 to cc do
             dirty_right.(i) <- tensor_row_extract columns.(i) ww
            done ;
            for i = 0 to pred r do
             let first_index = rows.(i) in
              let row_input_left = tensor_row_extract first_index w in
               for j = 0 to cc do
                let coefficient = V.scal_prod row_input_left dirty_right.(j) in
                 T.insert_add coefficient [| first_index ; columns.(j) |] result
               done ;
            done ;
            Sparse_tensor_matrix result
        end
       | Diff_to_scal_matrix ( xx , ww ) ->
        begin
         if Index.eq dn0 dn1 then
          add ( scal_mult xx m ) ( twisted_mult m ( Sparse_tensor_matrix ww ) )
         else
          twisted_mult m ( to_half_full n )
        end
       | _ -> twisted_mult m ( to_half_full n )
      end
     | Diff_to_scal_matrix ( x , w ) ->
      begin
       if Index.eq dm0 dm1 then
        add ( scal_mult x n ) ( twisted_mult ( Sparse_tensor_matrix w ) n )
       else
        twisted_mult ( to_half_full m ) n
      end
     | Diff_to_multi_scal_matrix ( a , w ) ->
      begin
       if Array.length a = 1 then
        twisted_mult ( Diff_to_scal_matrix ( a.(0) , w ) ) n
       else
        twisted_mult ( to_half_full m ) n
      end
     | _ -> twisted_mult ( to_half_full m ) n
    end ;;

(** 
mult matrix1 matrix2
*)

let rec mult = fun (m:t) (n:t) ->
 let dm = dimensions m
 and dn = dimensions n
 and test = ( description_eq_zero m , description_eq_zero n ) in
  let dm0 = dm.(0)
  and dm1 = dm.(1)
  and dn0 = dn.(0)
  and dn1 = dn.(1) in
   if not ( Index.eq dm1 dn0 ) then
    failwith "Bad dimensions in Sparse_matrix.Rng.mult." ;
   match test with
   | ( true , _ ) | ( false , true ) -> null [| dm0 ; dn1 |]
   | _ ->
    begin
     match m with
     | Half_full_matrix w  ->
      begin
       match n with
       | Half_full_matrix ww  -> twisted_mult m ( transpose ( to_sparse_tensor n ) )
       | Sparse_tensor_matrix ww ->
        begin
         let r = Index.to_int dm0 in
          let result = Array.map V.null ( Array.make r dn1 ) in
           let f = fun row_input_left row_output ( a , y ) ->
            begin
             let k = a.(0)
             and j = a.(1) in
              V.insert_add ( Coeff.mult ( V.raw_extract k row_input_left ) y ) j row_output
            end in
            for i = 0 to pred r do
             T.iter ( f w.(i) result.(i) ) ww ;
            done ;
            Half_full_matrix result
        end
       | Diff_to_scal_matrix ( xx , ww ) ->
        begin
         if Index.eq dn0 dn1 then
          add ( scal_mult xx m ) ( mult m ( Sparse_tensor_matrix ww ) )
         else
          mult m ( to_half_full n )
        end
       | _ -> mult m ( to_sparse_tensor n )
      end
     | Sparse_tensor_matrix w ->
      begin
       match n with
       | Sparse_tensor_matrix ww ->
        begin
         let result = T.null [| dm0 ; dn1 |]
         and rows = sparse_tensor_dirty_rows_array w
         and columns = sparse_tensor_dirty_columns_array ww in
          let r = Array.length rows
          and c = Array.length columns in
           let dirty_right = Array.map V.null ( Array.make c dn0 )
           and cc = pred c in
            for i = 0 to cc do
             dirty_right.(i) <- tensor_column_extract columns.(i) ww
            done ;
            for i = 0 to pred r do
             let first_index = rows.(i) in
              let row_input_left = tensor_row_extract first_index w in
               for j = 0 to cc do
                let coefficient = V.scal_prod row_input_left dirty_right.(j) in
                 T.insert_add coefficient [| first_index ; columns.(j) |] result
               done ;
            done ;
            Sparse_tensor_matrix result
        end
       | Diff_to_scal_matrix ( xx , ww ) ->
        begin
         if Index.eq dn0 dn1 then
          add ( Sparse_tensor_matrix ( T.scal_mult xx w ) ) ( mult m ( Sparse_tensor_matrix ww ) )
         else
          mult m ( to_half_full n )
        end
       | _ -> mult m ( to_sparse_tensor n )
      end
     | Diff_to_scal_matrix ( x , w ) ->
      begin
       if Index.eq dm0 dm1 then
        add ( scal_mult x n ) ( mult ( Sparse_tensor_matrix w ) n )
       else
        mult ( to_half_full m ) n
      end
     | Diff_to_multi_scal_matrix ( a , w ) ->
      begin
       if Array.length a = 1 then
        mult ( Diff_to_scal_matrix ( a.(0) , w ) ) n
       else
        mult ( to_half_full m ) n
      end
     | _ -> mult ( to_half_full m ) n
    end ;;

(** 
sparse_full_twisted_mult matrix1 matrix2
*)

let rec sparse_full_twisted_mult = fun (m:t) (n:coeff array array) ->
 let dm = dimensions m
 and rn = Array.length n
 and test = description_eq_zero m in
  let dm0 = dm.(0)
  and dm1 = dm.(1)
  and dn0 = Index.from_int rn in
   if ( Index.to_int dm1 ) <> rn then
    failwith "Bad dimensions in Sparse_matrix.Rng.sparse_full_twisted_mult." ;
   if test = true then
    null [| dm0 ; dn0 |]
   else
    begin
     match m with
     | Half_full_matrix w  ->
      begin
       let r = Index.to_int dm0 in
        let result = Array.map V.null ( Array.make r dn0 )
          and rr = pred r in
           for i = 0 to rr do
            let row_output = result.(i)
            and row_input_left = w.(i) in
             for j = 0 to rr do
              V.insert_add ( V.sparse_full_scal_prod row_input_left n.(j) ) ( Index.from_int j ) row_output
             done ;
           done ;
           Half_full_matrix result
      end
     | Sparse_tensor_matrix w ->
      begin
       let r = Index.to_int dn0 in
        let result = T.null [| dm0 ; dn0 |] in
         let f = fun j row_input_right ( a , y ) ->
          begin
           let i = a.(0)
           and k = a.(1) in
            T.insert_add ( Coeff.mult row_input_right.( Index.to_int k ) y ) [| i ; j |] result
          end in
          for j = 0 to pred r do
           T.iter ( f ( Index.from_int j ) n.(j) ) w ;
          done ;
          Sparse_tensor_matrix result
      end
     | _ -> sparse_full_twisted_mult ( to_half_full m ) n
    end ;;

(** 
sparse_full_mult matrix1 matrix2
*)

let sparse_full_mult = fun (m:t) (n:coeff array array) ->
 let dm = dimensions m
 and rn = Array.length n
 and cn = Array.length n.(0)
 and test = description_eq_zero m in
  let dm0 = dm.(0)
  and dm1 = dm.(1)
  and dn1 = Index.from_int cn in
   if ( Index.to_int dm1 ) <> rn then
    failwith "Bad dimensions in Sparse_matrix.Rng.sparse_full_mult." ;
   if test = true then
    null [| dm0 ; dn1 |]
   else
    sparse_full_twisted_mult m ( Util.transpose n ) ;;

(** 
full_sparse_twisted_mult matrix1 matrix2
*)

let rec full_sparse_twisted_mult = fun (m:coeff array array) (n:t) ->
 let dn = dimensions n
 and rm = Array.length m
 and cm = Array.length m.(0)
 and test = description_eq_zero n in
  let dn0 = dn.(0)
  and dn1 = dn.(1)
  and dm0 = Index.from_int rm in
   if cm <> ( Index.to_int dn1 ) then
    failwith "Bad dimensions in Sparse_matrix.Rng.full_sparse_twisted_mult." ;
   if test = true then
    null [| dm0 ; dn0 |]
   else
    begin
     match n with
     | Half_full_matrix w ->
      begin
       let result = Array.map V.null ( Array.make rm dn0 )
       and rr = pred rm
       and cc = pred cm in
        for i = 0 to rr do
         let row_output = result.(i)
         and row_input_left = m.(i) in
          for j = 0 to cc do
           V.insert_add ( V.sparse_full_scal_prod w.(j) row_input_left ) ( Index.from_int j ) row_output
          done ;
        done ;
        Half_full_matrix result
      end
     | Sparse_tensor_matrix w ->
      begin
       let result = Array.map V.null ( Array.make rm dn0 ) in
        let f = fun row_in row_out ( a , x ) -> V.insert_add ( Coeff.mult x row_in.( Index.to_int a.(1) ) ) a.(0) row_out in
         for i = 0 to pred rm do
          let row_output = result.(i)
          and row_input_left = m.(i) in
           T.iter ( f row_input_left row_output ) w
         done ;
         Half_full_matrix result
      end
     | _ -> full_sparse_twisted_mult m ( to_half_full n )
    end ;;

(** 
full_sparse_mult matrix1 matrix2
*)

let rec full_sparse_mult = fun (m:coeff array array) (n:t) ->
 let dn = dimensions n
 and rm = Array.length m
 and cm = Array.length m.(0)
 and test = description_eq_zero n in
  let dn0 = dn.(0)
  and dn1 = dn.(1)
  and dm0 = Index.from_int rm in
   if cm <> ( Index.to_int dn0 ) then
    failwith "Bad dimensions in Sparse_matrix.Rng.full_sparse_mult." ;
   if test = true then
    null [| dm0 ; dn1 |]
   else
    transpose ( sparse_full_twisted_mult ( transpose n ) m ) ;;

(** 
triple_mult matrix1 matrix2 matrix3
*)

let triple_mult = fun (m:t) (n:t) (p:t) ->
 twisted_mult m ( twisted_mult ( transpose p ) n ) ;;

(** 
commut matrix1 matrix2
*)

let commut = fun (m:t) (n:t) ->
 sub ( mult m n ) ( mult n m ) ;;





(**
§ § §
*)





end ;;







module Field (Index:Data.Index_type) (Hasher:Hash.Hash_type with type t = Index.t) (Coeff:Data.Field_coeff_type) = struct


include Rng (Index) (Hasher) (Coeff) ;;



module U = Sparse_vector.Field (Index) (Hasher) (Coeff) ;;



module S = Sparse_tensor.Field (Index) (Hasher) (Coeff) ;;



(** The coefficient two is used at different places for matrix calculations.

Le coefficient deux est utilisé à différents endroits pour les calculs matriciels. *)


let coeff_two = function () ->
 Coeff.add ( Coeff.one () ) ( Coeff.one () );;


(** The coefficient one half is used at different places for matrix calculations. The characteristic of the field is supposed to be different from two.

Le coefficient un demi est utilisé à différents endroits pour les calculs matriciels. On suppose que la caractéristique du corps est différente de deux. *)


let coeff_half = function () ->
 Coeff.inv ( coeff_two () ) ;;

(** 
scal_left_div scalar matrix
*)

let scal_left_div = fun (x:coeff) (m:t) ->
 scal_mult ( Coeff.inv x ) m ;;

(** 
reciprocal matrix
*)

let reciprocal = function (m:t) ->
 scal_left_div ( Coeff.norm_inject ( square_norm_frobenius m ) ) m ;;

(** 
sym matrix
*)

let sym = function (m:t) ->
 scal_mult ( coeff_half () ) ( add m ( transpose m ) ) ;;

(** 
antisym matrix
*)

let antisym = function (m:t) ->
 scal_mult ( coeff_half () ) ( sub m ( transpose m ) ) ;;

(** 
in_place_pivot_downward matrix1 matrix2
*)

let in_place_pivot_downward = fun (m:t) (p:t) ->
 let coeff = ref ( Coeff.zero () )
 and error_message = "Non invertible left matrix in Sparse_matrix.Field.in_place_pivot_downward." ;
 and dim = dimensions m
 and dip = dimensions p
 and i = ref 0 in
  let dim0 = dim.(0)
  and dim1 = dim.(1)
  and dip0 = dip.(0)
  and dip1 = dip.(1)
  and norm_coeff = ref ( Coeff.norm !coeff )
  and ii = ref ( Index.from_int !i ) in
   assert ( Index.eq dim0 dim1 ) ;
   assert ( Index.eq dim0 dip0 ) ;
   let row_left = ref ( U.null dim1 )
   and row_right = ref ( U.null dip1 )
   and substraction_row_left = ref ( U.null dim1 )
   and substraction_row_right = ref ( U.null dip1 )
   and row_output_left = ref ( U.null dim1 )
   and row_output_right = ref ( U.null dip1 )
   and col = ref ( U.null dim0 )
   and index = ref !ii
   and r = Index.to_int dim0 in
    let rr = pred r in
     while !i <= rr do
      ii := Index.from_int !i ;
      index := !ii ;
      coeff := extract !ii !ii m ;
      norm_coeff := Coeff.norm !coeff ;
      col := column_extract !ii m ;
      let f = function ( j , x ) ->
       begin
        if Index.compare j !ii > 0 then
         begin
          let nx = Coeff.norm x in
           if Coeff.norm_compare nx !norm_coeff > 0 then
            begin
             coeff := x ;
             norm_coeff := nx ;
             index := j ;
            end
         end
       end in
       U.iter f !col ;
       if Coeff.eq_zero !coeff then
        failwith error_message ;
       if not ( Index.eq !index !ii ) then
        begin
         row_exchange !index !ii m ;
         row_exchange !index !ii p ;
        end ;
       col := column_extract !ii m ;
       row_left := row_extract !ii m ;
       substraction_row_left := U.scal_left_div !coeff !row_left ;
       U.replace ( Coeff.one () ) !ii !substraction_row_left ;
       row_replace !substraction_row_left !ii m ;
       row_right := row_extract !ii p ;
       substraction_row_right := U.scal_left_div !coeff !row_right ;
       row_replace !substraction_row_right !ii p ;
       let g = function ( j , x ) ->
        begin
         if Index.compare j !ii > 0 then
          begin
           row_output_left := row_extract j m ;
           row_output_left := V.sub !row_output_left ( V.scal_mult x !substraction_row_left ) ;
           U.remove !ii !row_output_left ;
           row_replace !row_output_left j m ;
           row_output_right := row_extract j p ;
           row_output_right := V.sub !row_output_right ( V.scal_mult x !substraction_row_right ) ;
           row_replace !row_output_right j p ;
          end
        end in
        U.iter g !col ;
        incr i ;
     done ;;

(** 
pivot_downward matrix1 matrix2
*)

let pivot_downward = fun (m:t) (p:t) ->
 let mm = copy m
 and pp = copy p in
  in_place_pivot_downward mm pp ;
  [| mm ; pp |] ;;

(** 
invertibility matrix
*)

let invertibility = function (m:t) ->
 let mm = copy m
 and coefficient = ref ( Coeff.zero () )
 and coeff = ref ( Coeff.zero () )
 and dim = dimensions m
 and hh = ref ( Index.zero () )
 and i = ref 0 in
  let dim0 = dim.(0)
  and dim1 = dim.(1)
  and norm_coeff = ref ( Coeff.norm !coeff )
  and ii = ref ( Index.from_int !i ) in
   assert ( Index.eq dim0 dim1 ) ;
   let row_left = ref ( U.null dim1 )
   and substraction_row_left = ref ( U.null dim1 )
   and row_output_left = ref ( U.null dim1 )
   and col = ref ( U.null dim0 )
   and index = ref !ii
   and r = Index.to_int dim0 in
    let rr = pred r in
     try
      begin
       while !i <= rr do
        ii := Index.from_int !i ;
        index := !ii ;
        coeff := extract !ii !ii mm ;
        norm_coeff := Coeff.norm !coeff ;
        col := column_extract !ii mm ;
        let f = function ( j , x ) ->
         begin
          if Index.compare j !ii > 0 then
           begin
            let nx = Coeff.norm x in
             if Coeff.norm_compare nx !norm_coeff > 0 then
              begin
               coeff := x ;
               norm_coeff := nx ;
               index := j ;
              end
           end
         end in
         U.iter f !col ;
         if Coeff.eq_zero !coeff then
          failwith "The end." ;
         if not ( Index.eq !index !ii ) then
          row_exchange !index !ii mm ;
         row_left := row_extract !ii mm ;
         substraction_row_left := U.scal_left_div !coeff !row_left ;
         U.replace ( Coeff.one () ) !ii !substraction_row_left ;
         row_replace !substraction_row_left !ii mm ;
         for h = !i + 1 to rr do
          hh := Index.from_int h ;
          row_output_left := row_extract !hh mm ;
          coefficient := U.raw_extract !ii !row_output_left ;
          row_output_left := V.sub !row_output_left ( V.scal_mult !coefficient !substraction_row_left ) ;
          U.remove !ii !row_output_left ;
          row_replace !row_output_left !hh mm ;
         done ;
         incr i ;
       done ;
       true
      end
     with _ ->
      false ;;

(** 
det matrix
*)

let det = function (m:t) ->
 let mm = copy m
 and result = ref ( Coeff.one () )
 and coefficient = ref ( Coeff.zero () )
 and coeff = ref ( Coeff.zero () )
 and dim = dimensions m
 and hh = ref ( Index.zero () )
 and i = ref 0 in
  let dim0 = dim.(0)
  and dim1 = dim.(1)
  and norm_coeff = ref ( Coeff.norm !coeff )
  and ii = ref ( Index.from_int !i ) in
   assert ( Index.eq dim0 dim1 ) ;
   let row_left = ref ( U.null dim1 )
   and substraction_row_left = ref ( U.null dim1 )
   and row_output_left = ref ( U.null dim1 )
   and col = ref ( U.null dim0 )
   and index = ref !ii
   and r = Index.to_int dim0 in
    let rr = pred r in
     try
      begin
       while !i <= rr do
        ii := Index.from_int !i ;
        index := !ii ;
        coeff := extract !ii !ii mm ;
        norm_coeff := Coeff.norm !coeff ;
        col := column_extract !ii mm ;
        let f = function ( j , x ) ->
         begin
          if Index.compare j !ii > 0 then
           begin
            let nx = Coeff.norm x in
             if Coeff.norm_compare nx !norm_coeff > 0 then
              begin
               coeff := x ;
               norm_coeff := nx ;
               index := j ;
              end
           end
         end in
         U.iter f !col ;
         if Coeff.eq_zero !coeff then
          failwith "The end." ;
         if not ( Index.eq !index !ii ) then
          row_exchange !index !ii mm ;
         row_left := row_extract !ii mm ;
         result := Coeff.mult !result !coeff ;
         substraction_row_left := U.scal_left_div !coeff !row_left ;
         U.replace ( Coeff.one () ) !ii !substraction_row_left ;
         row_replace !substraction_row_left !ii mm ;
         for h = !i + 1 to rr do
          hh := Index.from_int h ;
          row_output_left := row_extract !hh mm ;
          coefficient := U.raw_extract !ii !row_output_left ;
          row_output_left := V.sub !row_output_left ( V.scal_mult !coefficient !substraction_row_left ) ;
          U.remove !ii !row_output_left ;
          row_replace !row_output_left !hh mm ;
         done ;
         incr i ;
       done ;
       !result
      end
     with _ ->
      Coeff.zero () ;;


(** 
in_place_pivot_upward matrix1 matrix2
The left matrix is supposed to be upper triangular with ones on the diagonal.

La matrice de gauche est supposée triangulaire supérieure avec des uns sur la diagonale. *)


let in_place_pivot_upward = fun (m:t) (p:t) ->
 let dim = dimensions m
 and dip = dimensions p
 and hh = ref ( Index.zero () ) in
  let dim0 = dim.(0)
  and dim1 = dim.(1)
  and dip0 = dip.(0)
  and dip1 = dip.(1) in
   assert ( Index.eq dim0 dim1 ) ;
   assert ( Index.eq dim0 dip0 ) ;
   let row_left = ref ( U.null dim1 )
   and row_right = ref ( U.null dip1 )
   and row_output_left = ref ( U.null dim1 )
   and row_output_right = ref ( U.null dip1 )
   and col = ref ( U.null dim0 )
   and r = Index.to_int dim0 in
    let rr = pred r in
     let i = ref rr in
      let ii = ref ( Index.from_int !i ) in
       while !i > 0 do
        ii := Index.from_int !i ;
        row_left := row_extract !ii m ;
        row_right := row_extract !ii p ;
        col := column_extract !ii m ;
        let g = function ( j , x ) ->
         begin
          if Index.compare j !ii < 0 then
           begin
            row_output_left := row_extract !hh m ;
            row_output_left := V.sub !row_output_left ( V.scal_mult x !row_left ) ;
            U.remove !ii !row_output_left ;
            row_replace !row_output_left !hh m ;
            row_output_right := row_extract !hh p ;
            row_output_right := V.sub !row_output_right ( V.scal_mult x !row_right ) ;
            row_replace !row_output_right !hh p ;
           end
         end in
         U.iter g !col ;
         decr i ;
       done ;;

(** 
pivot_upward matrix1 matrix2
*)

let pivot_upward = fun (m:t) (p:t) ->
 let mm = copy m
 and pp = copy p in
  in_place_pivot_upward mm pp ;
  [| mm ; pp |] ;;

(** 
inv matrix
*)

let inv = function (m:t) ->
 let p = Diff_to_scal_matrix ( Coeff.one () , T.null ( Array.make 2 ( dimensions m ).(0) ) )
 and mm = copy m in
  in_place_pivot_downward mm p ;
  in_place_pivot_upward mm p ;
  p ;;

(** 
left_quotient matrix1 matrix2
*)

let left_quotient = fun (m:t) (p:t) ->
 let mm = copy m
 and pp = copy p in
  in_place_pivot_downward mm pp ;
  in_place_pivot_upward mm pp ;
  pp ;;

(** 
right_quotient matrix1 matrix2
*)

let right_quotient = fun (m:t) (p:t) ->
 let mm = transpose m
 and pp = transpose p in
  in_place_pivot_downward pp mm ;
  in_place_pivot_upward pp mm ;
  transpose mm ;;

(** 
cond norm invertor matrix
*)

let cond = fun norm invertor (m:t) ->
 Coeff.norm_mult ( norm m ) ( norm ( invertor m ) ) ;;

(** 
naive_solve matrix vector
*)

let naive_solve = fun (m:t) (v:U.t) ->
 let mm = inv m in
  matrix_sparse_vector_sparse_prod mm v ;;

(** 
solve matrix vector
*)

let solve = fun (m:t) (v:U.t) ->
 let p = sparse_vector_to_column_matrix v in
  column_extract ( Index.zero () ) ( left_quotient m p ) ;;

(** 
full_solve matrix vector
*)

let full_solve = fun (m:t) (v:coeff array) ->
 let p = to_sparse ( -1 ) 1. ( Array.map ( Array.make 1 ) v ) in
  Array.map ( function x -> x.(0) ) ( to_full ( left_quotient m p ) ) ;;


(** 
tune_inv matrix inverse_candidate
*)

let tune_inv = fun (x:t) (y:t) ->
 let two = Diff_to_scal_matrix ( coeff_two () , S.null ( Array.make 2 ( dimensions x ).(0) ) )
 and right_product = mult x y in
  let difference = sub two right_product in
   mult y difference ;;

(** 
approx_inv distance invertor matrix
*)

let approx_inv = fun distance invertor (x:t) ->
 let y = invertor x in
  let product = mult x y
  and identity = Diff_to_scal_matrix ( Coeff.one () , T.null ( Array.make 2 ( dimensions x ).(0) ) )
  and result = tune_inv x y in
   let error0 = distance ( sub product identity )
   and new_product = mult x result in
    let error1 = distance ( sub new_product identity ) in
     if Coeff.norm_compare error1 error0 >=0 then
      ( y , error0 ) 
     else
      ( result , error1 ) ;;

(** 
extrap_inv parameter matrix
*)

let extrap_inv = fun (parameter:Coeff.t) (x:t) ->
 let y = inv x in
  let yy = tune_inv x y in
   add yy ( scal_mult parameter ( sub yy y ) ) ;;

(** 
approx_solve distance matrix vector
*)

let approx_solve = fun distance (m:t) (v:U.t) ->
 let mm = approx_inv distance inv m in
  matrix_sparse_vector_sparse_prod ( fst mm ) v ;;

(** 
approx_full_solve distance matrix vector
*)

let approx_full_solve = fun distance (m:t) (v:coeff array) ->
 let mm = approx_inv distance inv m in
  matrix_full_vector_sparse_prod ( fst mm ) v ;;


(** 
iterate exponent matrix vector
*)

let iterate = fun (s:int) (x:t) (v:U.t) ->
 let y = ref v in
  if s >= 0 then
   begin
    for i = 1 to s do
     y := matrix_sparse_vector_sparse_prod x !y ;
    done ;
   end
  else
   begin
    let xx = fst ( approx_inv norm_inf inv x ) in
     for i = 1 to ( abs s ) do
      y := matrix_sparse_vector_sparse_prod xx !y ;
     done ;
   end ;
  !y ;;

(** 
int_pow exponent matrix
*)

let rec int_pow = fun (s:int) (x:t) ->
 if s >= 0 then
  begin
   if s = 0 then
    Diff_to_scal_matrix ( Coeff.one () , T.null ( dimensions x ) )
   else
    begin
     let n = s / 2 in
      let factor = int_pow n x in
       let prod = mult factor factor in
        if s mod 2 = 0 then
         prod
        else
         mult prod x
    end
  end
 else
  int_pow ( abs s ) ( fst ( approx_inv norm_inf inv x ) ) ;;

(** 
find_first_pivot_downward tensor
*)

let find_first_pivot_downward = function (w:S.t) ->
 let coeff = ref ( Coeff.zero () )
 and index = ref ( Array.make 2 ( Index.witness () ) ) in
  let f = function ( i , x ) ->
   begin
    let i0 = i.(0)
    and i1 = i.(1)
    and index0 = !index.(0)
    and index1 = !index.(1) in
     if ( Index.compare i0 i1 > 0 ) && ( ( Index.eq index1 ( Index.witness () ) ) || ( Index.compare i1 index1 < 0 ) || ( ( Index.eq i1 index1 ) && ( Index.compare i0 index0 < 0 ) ) ) then
      begin
       coeff := x ;
       index := i ;
      end
   end in
   S.iter f w ;
   ( !index , !coeff ) ;;

(** 
find_first_pivot_upward tensor
*)

let find_first_pivot_upward = function (w:S.t) ->
 let coeff = ref ( Coeff.zero () )
 and index = ref ( Array.make 2 ( Index.witness () ) ) in
  let f = function ( i , x ) ->
   begin
    let i0 = i.(0)
    and i1 = i.(1)
    and index0 = !index.(0)
    and index1 = !index.(1) in
     if ( Index.compare i0 i1 < 0 ) && ( ( Index.eq index1 ( Index.witness () ) ) || ( Index.compare i1 index1 > 0 ) || ( ( Index.eq i1 index1 ) && ( Index.compare i0 index0 > 0 ) ) ) then
      begin
       coeff := x ;
       index := i ;
      end
   end in
   S.iter f w ;
   ( !index , !coeff ) ;;

(** 
in_place_diff_to_id_pivot_downward matrix1 matrix2
*)

let in_place_diff_to_id_pivot_downward = fun (m:t) (p:t) ->
 let dim = dimensions m
 and error_string = "The first argument must be Diff_to_scal_matrix ( Coeff.one , sparse_tensor ) in Sparse_matrix.Field.diff_to_id_pivot_downward."
 and error_message = "Non invertible left matrix in Sparse_matrix.Field.in_place_diff_to_id_pivot_downward" in
  match m with
  | Diff_to_scal_matrix ( x , w ) ->
   begin
    if Coeff.eq_one x then
     begin
      let coefficient = ref ( Coeff.zero () )
      and coeff = ref ( Coeff.zero () )
      and pivot = ref ( find_first_pivot_downward w )
      and dip = dimensions p in
       let i = ref ( fst !pivot ).(1)
       and dim0 = dim.(0)
       and dim1 = dim.(1)
       and dip1 = dip.(1)
       and norm_coeff = ref ( Coeff.norm !coeff ) in
        assert ( Index.eq dim0 dim1 ) ;
        assert ( Index.eq dim0 dip.(0) ) ;
        let row_left = ref ( U.null dim1 )
        and row_right = ref ( U.null dip1 )
        and si = ref ( Index.succ !i )
        and substraction_row_left = ref ( U.null dim1 )
        and substraction_row_right = ref ( U.null dip1 )
        and row_output_left = ref ( U.null dim1 )
        and row_output_right = ref ( U.null dip1 )
        and rr = Index.pred dim0
        and cc = Index.pred dim1
        and index = ref !i in
         while not ( Index.eq !i ( Index.witness () ) ) do
          index := !i ;
          coeff := extract !i !i m ;
          norm_coeff := Coeff.norm !coeff ;
          let f = function ( j , x ) ->
           begin
            let nx = Coeff.norm x in
             if Coeff.norm_compare nx !norm_coeff > 0 then
              begin
               coeff := x ;
               norm_coeff := nx ;
               index := j.(0) ;
              end
           end in
           tensor_sub_column_iter f !i !si rr w ;
           if Coeff.eq_zero !coeff then
            failwith error_message ;
           if not ( Index.eq !index !i ) then
            begin
             row_exchange !index !i m ;
             row_exchange !index !i p ;
            end ;
           row_left := row_extract !i m ;
           substraction_row_left := U.scal_left_div !coeff !row_left ;
           U.replace ( Coeff.one () ) !i !substraction_row_left ;
           row_replace !substraction_row_left !i m ;
           row_right := row_extract !i p ;
           substraction_row_right := U.scal_left_div !coeff !row_right ;
           row_replace !substraction_row_right !i p ;
           let g = function ( j , x ) ->
            begin
             let j0 = j.(0) in
              row_output_left := row_extract j0 m ;
              coefficient := U.raw_extract !i !row_output_left ;
              row_output_left := U.sub !row_output_left ( V.scal_mult !coefficient !substraction_row_left ) ;
              U.remove !i !row_output_left ;
              row_replace !row_output_left j0 m ;
              row_output_right := row_extract j0 p ;
              row_output_right := U.sub !row_output_right ( V.scal_mult !coefficient !substraction_row_right ) ;
              row_replace !row_output_right j0 p ;
            end in
            tensor_sub_column_iter g !i !si rr w ;
            pivot := find_first_pivot_downward w ;
            i := ( fst !pivot ).(1) ;
            si := Index.succ !i ;
         done ;
         let ff = function ( j , x ) ->
          begin
           let j0 = j.(0) in
            if Index.eq j0 j.(1) then
             begin
              coefficient := Coeff.add x ( Coeff.one () ) ;
              if Coeff.eq_zero !coefficient then
               failwith error_message ;
              coeff := Coeff.inv !coefficient ;
              row_output_left := tensor_sub_row_extract j0 ( Index.succ j0 ) cc w ;
              row_output_left := U.scal_mult !coeff !row_output_left ;
              tensor_row_replace !row_output_left j0 w ;
              row_output_right := row_extract j0 p ;
              row_output_right := U.scal_mult !coeff !row_output_right ;
              row_replace !row_output_right j0 p ;
             end
          end in
          S.iter ff w ;
     end
    else
     failwith error_string
   end
  | _ -> failwith error_string ;;

(** 
diff_to_id_pivot_downward matrix1 matrix2
*)

let diff_to_id_pivot_downward = fun (m:t) (p:t) ->
 let mm = copy m
 and pp = copy p in
  in_place_diff_to_id_pivot_downward mm pp ;
  [| mm ; pp |] ;;

(** 
diff_to_id_invertibility matrix
*)

let diff_to_id_invertibility = function (mm:t) ->
 let m = copy mm
 and dim = dimensions mm
 and error_string = "The argument must be Diff_to_scal_matrix ( Coeff.one , sparse_tensor ) in Sparse_matrix.Field.diff_to_id_invertibility."
 and error_message = "Not invertible." in
  match m with
  | Diff_to_scal_matrix ( x , w ) ->
   begin
    if Coeff.eq_one x then
     begin
      let coefficient = ref ( Coeff.zero () )
      and result = ref true
      and coeff = ref ( Coeff.zero () )
      and pivot = ref ( find_first_pivot_downward w ) in
       let i = ref ( fst !pivot ).(1)
       and dim0 = dim.(0)
       and dim1 = dim.(1)
       and norm_coeff = ref ( Coeff.norm !coeff ) in
        assert ( Index.eq dim0 dim1 ) ;
        let row_left = ref ( U.null dim1 )
        and si = ref ( Index.succ !i )
        and substraction_row_left = ref ( U.null dim1 )
        and row_output_left = ref ( U.null dim1 )
        and rr = Index.pred dim0
        and index = ref !i in
         while not ( Index.eq !i ( Index.witness () ) ) do
          index := !i ;
          coeff := extract !i !i m ;
          norm_coeff := Coeff.norm !coeff ;
          let f = function ( j , x ) ->
           begin
            let nx = Coeff.norm x in
             if Coeff.norm_compare nx !norm_coeff > 0 then
              begin
               coeff := x ;
               norm_coeff := nx ;
               index := j.(0) ;
              end
           end in
           tensor_sub_column_iter f !i !si rr w ;
           if Coeff.eq_zero !coeff then
            begin
             result := false ;
             i := Index.witness () ;
            end
           else
            begin
             if not ( Index.eq !index !i ) then
              begin
               row_exchange !index !i m ;
              end ;
             row_left := row_extract !i m ;
             substraction_row_left := U.scal_left_div !coeff !row_left ;
             U.replace ( Coeff.one () ) !i !substraction_row_left ;
             row_replace !substraction_row_left !i m ;
             let g = function ( j , x ) ->
              begin
               let j0 = j.(0) in
                row_output_left := row_extract j0 m ;
                coefficient := U.raw_extract !i !row_output_left ;
                row_output_left := U.sub !row_output_left ( V.scal_mult !coefficient !substraction_row_left ) ;
                U.remove !i !row_output_left ;
                row_replace !row_output_left j0 m ;
              end in
              tensor_sub_column_iter g !i !si rr w ;
              pivot := find_first_pivot_downward w ;
              i := ( fst !pivot ).(1) ;
              si := Index.succ !i ;
            end
         done ;
         let ff = function ( j , x ) ->
          begin
           let j0 = j.(0) in
            if Index.eq j0 j.(1) then
             begin
              coefficient := Coeff.add x ( Coeff.one () ) ;
              if Coeff.eq_zero !coefficient then
               failwith error_message ;
             end
          end in
          begin
           try
            S.iter ff w
           with _ ->
            result := false
          end ;
          !result ;
     end
    else
     failwith error_string
   end
  | _ -> failwith error_string ;;

(** 
diff_to_id_det matrix
*)

let diff_to_id_det = function (mm:t) ->
 let m = copy mm
 and dim = dimensions mm
 and error_string = "The argument must be Diff_to_scal_matrix ( Coeff.one , sparse_tensor ) in Sparse_matrix.Field.diff_to_id_det."
 and error_message = "Not invertible." in
  match m with
  | Diff_to_scal_matrix ( x , w ) ->
   begin
    if Coeff.eq_one x then
     begin
      let coefficient = ref ( Coeff.zero () )
      and result = ref ( Coeff.one () )
      and coeff = ref ( Coeff.zero () )
      and pivot = ref ( find_first_pivot_downward w ) in
       let i = ref ( fst !pivot ).(1)
       and dim0 = dim.(0)
       and dim1 = dim.(1)
       and norm_coeff = ref ( Coeff.norm !coeff ) in
        assert ( Index.eq dim0 dim1 ) ;
        let row_left = ref ( U.null dim1 )
        and si = ref ( Index.succ !i )
        and substraction_row_left = ref ( U.null dim1 )
        and row_output_left = ref ( U.null dim1 )
        and rr = Index.pred dim0
        and index = ref !i in
         while not ( Index.eq !i ( Index.witness () ) ) do
          index := !i ;
          coeff := extract !i !i m ;
          norm_coeff := Coeff.norm !coeff ;
          let f = function ( j , x ) ->
           begin
            let nx = Coeff.norm x in
             if Coeff.norm_compare nx !norm_coeff > 0 then
              begin
               coeff := x ;
               norm_coeff := nx ;
               index := j.(0) ;
              end
           end in
           tensor_sub_column_iter f !i !si rr w ;
           if Coeff.eq_zero !coeff then
            begin
             result := Coeff.zero () ;
             i := Index.witness () ;
            end
           else
            begin
             result := Coeff.mult !result !coeff ;
             if not ( Index.eq !index !i ) then
              begin
               row_exchange !index !i m ;
              end ;
             row_left := row_extract !i m ;
             substraction_row_left := U.scal_left_div !coeff !row_left ;
             U.replace ( Coeff.one () ) !i !substraction_row_left ;
             row_replace !substraction_row_left !i m ;
             let g = function ( j , x ) ->
              begin
               let j0 = j.(0) in
                row_output_left := row_extract j0 m ;
                coefficient := U.raw_extract !i !row_output_left ;
                row_output_left := U.sub !row_output_left ( V.scal_mult !coefficient !substraction_row_left ) ;
                U.remove !i !row_output_left ;
                row_replace !row_output_left j0 m ;
              end in
              tensor_sub_column_iter g !i !si rr w ;
              pivot := find_first_pivot_downward w ;
              i := ( fst !pivot ).(1) ;
              si := Index.succ !i ;
            end
         done ;
         let ff = function ( j , x ) ->
          begin
           let j0 = j.(0) in
            if Index.eq j0 j.(1) then
             begin
              coefficient := Coeff.add x ( Coeff.one () ) ;
              if Coeff.eq_zero !coefficient then
               failwith error_message
              else
               result := Coeff.mult !result !coefficient ;
             end
          end in
          begin
           try
            S.iter ff w
           with _ ->
            result := Coeff.zero ()
          end ;
         !result ;
     end
    else
     failwith error_string
   end
  | _ -> failwith error_string ;;


(** 
in_place_diff_to_id_pivot_upward matrix1 matrix2
The left matrix is supposed to be upper triangular with ones on the diagonal.

La matrice de gauche est supposée triangulaire supérieure avec des uns sur la diagonale. *)


let in_place_diff_to_id_pivot_upward = fun (m:t) (p:t) ->
 let dim = dimensions m
 and error_string = "The first argument must be Diff_to_scal_matrix ( Coeff.one , sparse_tensor ) in Sparse_matrix.Field.diff_to_id_pivot_upward." in
  match m with
  | Diff_to_scal_matrix ( x , w ) ->
   begin
    if Coeff.eq_one x then
     begin
      let coefficient = ref ( Coeff.zero () )
      and pivot = ref ( find_first_pivot_upward w )
      and z = Index.zero ()
      and dip = dimensions p in
       let i = ref ( fst !pivot ).(1)
       and dim0 = dim.(0)
       and dim1 = dim.(1)
       and dip0 = dip.(0)
       and dip1 = dip.(1) in
        assert ( Index.eq dim0 dim1 ) ;
        assert ( Index.eq dim0 dip0 ) ;
        let row_left = ref ( U.null dim1 )
        and row_right = ref ( U.null dip1 )
        and row_output_left = ref ( U.null dim1 )
        and row_output_right = ref ( U.null dip1 )
        and pi = ref ( Index.pred !i ) in
         while not ( Index.eq !i ( Index.witness () ) ) do
          row_left := row_extract !i m ;
          row_right := row_extract !i p ;
          let g = function ( j , x ) ->
           begin
            let j0 = j.(0) in
             row_output_left := row_extract j0 m ;
             coefficient := U.raw_extract !i !row_output_left ;
             row_output_left := V.sub !row_output_left ( V.scal_mult !coefficient !row_left ) ;
             U.remove !i !row_output_left ;
             row_replace !row_output_left j0 m ;
             row_output_right := row_extract j0 p ;
             row_output_right := V.sub !row_output_right ( V.scal_mult !coefficient !row_right ) ;
             row_replace !row_output_right j0 p ;
           end in
           tensor_sub_column_iter g !i z !pi w ;
           pivot := find_first_pivot_downward w ;
           i := ( fst !pivot ).(1) ;
           pi := Index.pred !i ;
         done ;
     end
    else
     failwith error_string
   end
  | _ -> failwith error_string ;;


(** 
diff_to_id_pivot_upward matrix1 matrix2
The left matrix is supposed to be upper triangular with ones on the diagonal.

La matrice de gauche est supposée triangulaire supérieure avec des uns sur la diagonale. *)


let diff_to_id_pivot_upward = fun (m:t) (p:t) ->
 let mm = copy m
 and pp = copy p in
  in_place_diff_to_id_pivot_upward mm pp ;
  [| mm ; pp |] ;;

(** 
diff_to_id_inv matrix
*)

let diff_to_id_inv = function (m:t) ->
 let p = Diff_to_scal_matrix ( Coeff.one () , T.null ( Array.make 2 ( dimensions m ).(0) ) )
 and mm = copy m in
  in_place_diff_to_id_pivot_downward mm p ;
  in_place_diff_to_id_pivot_upward mm p ;
  p ;;


(** 
diff_to_id_left_quotient matrix1 matrix2
*)

let diff_to_id_left_quotient = fun (m:t) (p:t) ->
 let mm = copy m
 and pp = copy p in
  in_place_diff_to_id_pivot_downward mm pp ;
  in_place_diff_to_id_pivot_upward mm pp ;
  pp ;;

(** 
diff_to_id_right_quotient matrix1 matrix2
*)

let diff_to_id_right_quotient = fun (m:t) (p:t) ->
 let mm = transpose m
 and pp = transpose p in
  in_place_diff_to_id_pivot_downward pp mm ;
  in_place_diff_to_id_pivot_upward pp mm ;
  transpose mm ;;

(** 
diff_to_id_solve matrix vector
*)

let diff_to_id_solve = fun (m:t) (v:U.t) ->
 let p = sparse_vector_to_column_matrix v in
  column_extract ( Index.zero () ) ( diff_to_id_left_quotient m p ) ;;

(** 
diff_to_id_full_solve matrix vector
*)

let diff_to_id_full_solve = fun (m:t) (v:coeff array) ->
 let p = to_sparse ( -1 ) 1. ( Array.map ( Array.make 1 ) v ) in
  Array.map ( function x -> x.(0) ) ( to_full ( diff_to_id_left_quotient m p ) ) ;;

(** 
diff_to_id_tune_inv matrix
*)

let diff_to_id_tune_inv = function (m:t) ->
 tune_inv m ( diff_to_id_inv m ) ;;

(** 
diff_to_id_tune_solve matrix vector
*)

let diff_to_id_tune_solve = fun (m:t) (v:U.t) ->
 let mm = tune_inv m ( diff_to_id_inv m ) in
  matrix_sparse_vector_sparse_prod mm v ;;

(** 
diff_to_id_tune_full_solve matrix vector
*)

let diff_to_id_tune_full_solve = fun (m:t) (v:coeff array) ->
 let mm = diff_to_id_tune_inv m in
  matrix_full_vector_sparse_prod mm v ;;


(** 
diff_to_id_iterate exponent matrix vector
*)

let diff_to_id_iterate = fun (s:int) (x:t) (v:U.t) ->
 let y = ref v in
  if s >= 0 then
   begin
    for i = 1 to s do
     y := matrix_sparse_vector_sparse_prod x !y ;
    done ;
   end
  else
   begin
    let xx = diff_to_id_tune_inv x in
     for i = 1 to ( abs s ) do
      y := matrix_sparse_vector_sparse_prod xx !y ;
     done ;
   end ;
  !y ;;

(** 
diff_to_id_int_pow exponent matrix
*)

let rec diff_to_id_int_pow = fun (s:int) (x:t) ->
 if s >= 0 then
  begin
   if s = 0 then
    Diff_to_scal_matrix ( Coeff.one () , T.null ( dimensions x ) )
   else
    begin
     let n = s / 2 in
      let factor = int_pow n x in
       let prod = mult factor factor in
        if s mod 2 = 0 then
         prod
        else
         mult prod x
    end
  end
 else
  int_pow ( abs s ) ( diff_to_id_tune_inv x ) ;;










(**
§ § §
*)







end ;;





(**
§ § §
*)






end ;;








module Mat = struct


(**)
(**
§
*)

(**

Introduction

 *)

(**
*)





(** The mathematician will find in this module functors to practice calculations on vectors, tensors and matrices with coefficients in a commutative rng or a field.

Comments

The objects may indifferently be full or sparse.

This module is distributed under the same licence as Ocaml.

§

La mathématicienne ou le mathématicien trouvera dans ce module des foncteurs permettant de pratiquer le calcul sur les vecteurs, tenseurs et matrices à coefficients dans un annau commutatif ou dans un corps commutatif.

Commentaires

Les objets peuvent être indifféremment pleins ou creux.

Ce module est distribué selon la même licence qu'Ocaml.

Copyright Stéphane Grognet
Laboratoire de mathématiques Jean Leray UMR 6629 CNRS
Fédération de recherche mathématique des Pays de la Loire
IREM des Pays de la Loire - Université de Nantes
version 0.1
*)

(** @version 0.1 *)

(** @author Stéphane Grognet *)

(** @since 2012, 2013 *)




(** The following utilities are shared by the functors defined in this module.

Util ; Data ; Sparse ; Sparser

Les utilitaires précédents sont communs aux foncteurs définis dans ce module. *)


open Util ;;
open Data ;;
open Hash ;;
open Sparse_vector ;;
open Sparse_tensor ;;
open Sparse_matrix ;;



module Rng (R:Data.Rng_coeff_type) = struct




(**
§
*)

(**

Introduction

 *)

(**
*)





(**

*)





(**
§
*)

(**

Utilitaires

Utilities

 *)

(**
*)





module V = Sparse_vector.Rng (Data.Zindex) (Hash.Z) (R) ;;
module T = Sparse_tensor.Rng (Data.Zindex) (Hash.Z) (R) ;;
module M = Sparse_matrix.Rng (Data.Zindex) (Hash.Z) (R) ;;


type coeff = R.t ;;
type index = int ;;
type elt = index * coeff ;;



(**
§
*)

(**

Vecteurs

Vectors

 *)

(**
*)





(** The vector type gathers all formats of vectors with coefficients of type coeff.

Le type vector rassemble tous les formats de vecteurs à coefficients de type coeff. *)


type vector =
 | Full_vector of coeff array
 | Sparse_vector of V.t ;;

(** 
vector_copy vector
*)

let vector_copy = function (v:vector) ->
 match v with
 | Full_vector w -> Full_vector ( Array.map R.copy w )
 | Sparse_vector w -> Sparse_vector ( V.copy w ) ;;

(** 
vector_resize vector
*)

let vector_resize = fun (n:int) (v:vector) ->
 match v with
 | Full_vector w -> ()
 | Sparse_vector w -> V.resize n w ;;

(** 
array_null dimension
*)

let array_null = function (dim:int) ->
 Array.map R.zero ( Array.make dim () ) ;;

(** 
vector_full_null dimension
*)

let vector_full_null = function (dim:int) ->
 Full_vector ( array_null dim ) ;;

(** 
vector_sparse_null dimension
*)

let vector_sparse_null = function (dim:int) ->
 Sparse_vector ( V.null dim ) ;;

(** 
vector_null dimension
*)

let vector_null = vector_sparse_null ;;

(** 
vector_zero unit
*)

let vector_zero = function () ->
 vector_sparse_null 0 ;;

(** 
vector_full_demakeup vector
*)

let vector_full_demakeup = function (v:vector) ->
 match v with
 | Full_vector w -> w
 | Sparse_vector w -> failwith "Not a full vector in Mat.vector_full_demakeup." ;;

(** 
vector_sparse_demakeup vector
*)

let vector_sparse_demakeup = function (v:vector) ->
 match v with
 | Full_vector w -> failwith "Not a sparse vector in Mat.vector_sparse_demakeup."
 | Sparse_vector w -> w ;;


(** 
vector_to_full vector
This function is not sealed.

Cette fonction n'est pas étanche. *)


let vector_to_full = function (v:vector) ->
 match v with
 | Full_vector w -> v
 | Sparse_vector w -> Full_vector ( V.to_full w ) ;;


(** 
vector_to_sparse vector
This function is not sealed.

Cette fonction n'est pas étanche. *)


let vector_to_sparse = function (v:vector) ->
 match v with
 | Full_vector w -> Sparse_vector ( V.auto_to_sparse w )
 | Sparse_vector w -> v ;;

(** 
vector_dimension vector
*)

let vector_dimension = function (v:vector) ->
 match v with
 | Full_vector w -> Array.length w
 | Sparse_vector w -> V.dimension w ;;

(** 
vector_nihil vector
*)

let vector_nihil = function (v:vector) ->
 let d = vector_dimension v in
  match v with
  | Full_vector w -> vector_full_null d
  | Sparse_vector w ->
   begin
    let z = vector_sparse_null d in
     vector_resize ( V.size w ) z ;
     z
   end ;;

(** 
vector_filling vector
*)

let vector_filling = function (v:vector) ->
 match v with
 | Full_vector w -> failwith "Full vector in Mat.vector_filling."
 | Sparse_vector w -> V.filling w ;;

(** 
vector_size vector
*)

let vector_size = function (v:vector) ->
 match v with
 | Full_vector w -> failwith "Full vector in Mat.vector_size."
 | Sparse_vector w -> V.size w ;;

(** 
vector_quality vector
*)

let rec vector_quality = function (v:vector) ->
 match v with
 | Full_vector w -> "Full vector"
 | Sparse_vector w -> "Sparse vector" ;;

(** 
vector_to_string vector
*)

let rec vector_to_string = function (v:vector) ->
 match v with
 | Full_vector w -> "Full_vector " ^ ( Util.vector_to_string R.to_string "[|" " " "|]" w )
 | Sparse_vector w -> "Sparse_vector " ^ ( V.to_string w ) ;;

(** 
bare_vector_print vector
*)

let bare_vector_print = function (v:vector) ->
 print_string ( vector_to_string v ) ;;

(** 
vector_print vector
*)

let vector_print = function (v:vector) ->
 print_string ( vector_to_string v ) ;
 print_newline () ;;

(** 
vector_of_string string
*)

let vector_of_string = function (s:string) ->
 let lst = String.length s
 and index = Str.search_forward ( Str.regexp " " ) s 0 in
  let qualif = String.sub s 0 index
  and rest = String.sub s ( succ index ) ( lst - index - 1 ) in
   match qualif with
   | "Full_vector" -> Full_vector ( Util.bare_vector_of_string R.of_string rest )
   | "Sparse_vector" -> Sparse_vector ( V.of_string rest )
   | _ -> failwith "Not a valid string in Mat.vector_of_string." ;;

(** 
vector_extract index vector
*)

let vector_extract = fun (i:int) (v:vector) ->
 match v with
 | Full_vector w -> R.copy w.(i)
 | Sparse_vector w -> V.raw_extract i w ;;


(** 
vector_head index vector
This function is not sealed.

Cette fonction n'est pas étanche. *)


let vector_head = fun (i:int) (v:vector) ->
 match v with
 | Full_vector w -> Full_vector ( Array.sub w 0 ( succ i ) )
 | Sparse_vector w -> Sparse_vector ( V.sub_vector 0 i w ) ;;


(** 
vector_tail index vector
This function is not sealed.

Cette fonction n'est pas étanche. *)


let vector_tail = fun (i:int) (v:vector) ->
 match v with
 | Full_vector w -> Full_vector ( Util.array_end i w )
 | Sparse_vector w -> Sparse_vector ( V.sub_vector i ( pred ( V.dimension w ) ) w ) ;;


(** 
sub_vector beginning ending vector
This function is not sealed.

Cette fonction n'est pas étanche. *)


let sub_vector = fun (i:int) (j:int) (v:vector) ->
 match v with
 | Full_vector w -> Full_vector ( Array.sub w i ( j - i + 1 ) )
 | Sparse_vector w -> Sparse_vector ( V.sub_vector i j w ) ;;


(** 
mask_vector beginning ending vector
This function is not sealed.

Cette fonction n'est pas étanche. *)


let mask_vector = fun (i:int) (j:int) (v:vector) ->
 match v with
 | Full_vector w ->
  begin
   let r = Array.length w in
    let result = array_null r in
     for k = i to j do
      result.(k) <- w.(k)
     done ;
     Full_vector result
  end
 | Sparse_vector w -> Sparse_vector ( V.mask_vector i j w ) ;;


(** 
vector_beginning index vector
This function is not sealed.

Cette fonction n'est pas étanche. *)


let vector_beginning = fun (i:int) (v:vector) ->
 match v with
 | Full_vector w -> mask_vector 0 i v
 | Sparse_vector w -> Sparse_vector ( V.beginning i w ) ;;


(** 
vector_ending index vector
This function is not sealed.

Cette fonction n'est pas étanche. *)


let vector_ending = fun (i:int) (v:vector) ->
 match v with
 | Full_vector w -> mask_vector i ( pred ( Array.length w ) ) v
 | Sparse_vector w -> Sparse_vector ( V.ending i w ) ;;


(** 
vector_embed dimension index vector
This function is not sealed.

Cette fonction n'est pas étanche. *)


let vector_embed = fun (dimension:int) (shift:int) (v:vector) ->
 match v with
 | Full_vector w ->
  begin
   let t = max 0 shift in
    let tt = max 0 ( dimension - ( t + ( Array.length w ) ) ) in
     Full_vector ( Array.concat [ array_null t ; w ; array_null tt ] )
  end
 | Sparse_vector w -> Sparse_vector ( V.embed dimension shift w ) ;;

(** 
vector_find element vector
*)

let vector_find = fun (x:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Util.vector_find_first R.eq x w
 | Sparse_vector w -> V.find x w ;;

(** 
vector_find_all element vector
*)

let vector_find_all = fun (x:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Util.vector_find_all R.eq x w
 | Sparse_vector w -> Array.of_list ( V.index_list_find_all x w ) ;;

(** 
vector_list_find_all element vector
*)

let vector_list_find_all = fun (x:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Array.to_list ( Util.vector_find_all R.eq x w )
 | Sparse_vector w -> V.index_list_find_all x w ;;

(** 
vector_filter predicate vector
*)

let vector_filter = fun (p:index -> bool) (v:vector) ->
 match v with
 | Full_vector w -> Util.vector_filter p w
 | Sparse_vector w -> V.filter p w ;;

(** 
vector_first_non_zero vector
*)

let vector_first_non_zero = fun (v:vector) ->
 match v with
 | Sparse_vector w -> V.first_non_zero w
 | Full_vector w ->
  begin
   let d = Array.length w in
    let i = ref 0
    and index = ref ( -1 ) in
     while !i < d do
      if R.eq_zero w.(!i) then
       incr i
      else
       begin
        index := !i ;
        i := d ;
       end
     done ;
     !index
  end ;;

(** 
vector_last_non_zero vector
*)

let vector_last_non_zero = function (v:vector) ->
 match v with
 | Sparse_vector w -> V.last_non_zero w
 | Full_vector w ->
  begin
   let d = Array.length w in
    let i = ref ( pred d )
    and index = ref ( -1 ) in
     while !i >= 0 do
      if R.eq_zero w.(!i) then
       decr i
      else
       begin
        index := !i ;
        i := -1 ;
       end
     done ;
     !index
  end ;;

(** 
vector_exchange index1 index2 vector
*)

let vector_exchange = fun (i:int) (j:int) (v:vector) ->
 match v with
 | Full_vector w ->
  begin
   let tmp = R.copy w.(i) in
    w.(i) <- w.(j) ;
    w.(j) <- tmp ;
  end
 | Sparse_vector w -> V.exchange i j w ;;

(** 
vector_maximum vector
*)

let vector_maximum = function (v:vector) ->
 match v with
 | Full_vector w -> Util.array_maximum R.compare w
 | Sparse_vector w -> V.max w ;;

(** 
vector_minimum vector
*)

let vector_minimum = function (v:vector) ->
 match v with
 | Full_vector w -> Util.array_minimum R.compare w
 | Sparse_vector w -> V.min w ;;

(** 
vector_iter function vector
*)

let vector_iter = fun (f:elt -> unit) (v:vector) ->
 match v with
 | Full_vector w ->
  begin
   let g = fun i x -> f ( i , x ) in
    Array.iteri g w
  end
 | Sparse_vector w -> V.iter f w ;;

(** 
vector_fold function vector init
*)

let vector_fold = fun f (v:vector) init ->
 match v with
 | Full_vector w ->
  begin
   let accu = ref init in
    for i = 0 to pred ( Array.length w ) do
     accu := f ( i , w.(i) ) !accu 
    done ;
    !accu
  end
 | Sparse_vector w -> V.fold f w init ;;

(** 
vector_in_place_map function vector
*)

let vector_in_place_map = fun f (v:vector) ->
 match v with
 | Full_vector w ->
  begin
   for i = 0 to pred ( Array.length w ) do
    w.(i) <- f w.(i)
   done ;
  end
 | Sparse_vector w -> V.in_place_map f w ;;

(** 
vector_in_place_mapi function vector
*)

let vector_in_place_mapi = fun f (v:vector) ->
 match v with
 | Full_vector w ->
  begin
   for i = 0 to pred ( Array.length w ) do
    w.(i) <- f i w.(i)
   done ;
  end
 | Sparse_vector w -> V.in_place_mapi f w ;;

(** 
vector_map function vector
*)

let vector_map = fun f (v:vector) ->
 match v with
 | Full_vector w ->
  begin
   let r = Array.length w in
    let ww = array_null r in
     for i = 0 to pred r do
      ww.(i) <- f w.(i)
     done ;
     Full_vector ww
  end
 | Sparse_vector w -> Sparse_vector ( V.map f w ) ;;

(** 
vector_mapi function vector
*)

let vector_mapi = fun f (v:vector) ->
 match v with
 | Full_vector w ->
  begin
   let r = Array.length w in
    let ww = array_null r in
     for i = 0 to pred r do
      ww.(i) <- f i w.(i)
     done ;
     Full_vector ww
  end
 | Sparse_vector w -> Sparse_vector ( V.mapi f w ) ;;

(** 
vector_insert_add coefficient index vector
*)

let vector_insert_add = fun (x:coeff) (i:int) (v:vector) ->
 match v with
 | Full_vector w -> w.(i) <- R.add w.(i) x
 | Sparse_vector w -> V.insert_add x i w ;;

(** 
vector_insert_sub coefficient index vector
*)

let vector_insert_sub = fun (x:coeff) (i:int) (v:vector) ->
 match v with
 | Full_vector w -> w.(i) <- R.sub w.(i) x
 | Sparse_vector w -> V.insert_sub x i w ;;

(** 
vector_remove index vector
*)

let vector_remove = fun (i:int) (v:vector) ->
 match v with
 | Full_vector w -> w.(i) <- R.zero ()
 | Sparse_vector w -> V.remove i w ;;

(** 
vector_replace coefficient index vector
*)

let vector_replace = fun (x:coeff) (i:int) (v:vector) ->
 match v with
 | Full_vector w -> w.(i) <- x
 | Sparse_vector w -> V.replace x i w ;;

(** 
vector_in_place_opp vector
*)

let vector_in_place_opp = function (v:vector) ->
 match v with
 | Full_vector w -> Array.iteri ( fun i x -> w.(i) <- R.opp x ) w
 | Sparse_vector w -> V.in_place_opp w ;;

(** 
vector_opp vector
*)

let vector_opp = function (v:vector) ->
 match v with
 | Full_vector w -> Full_vector ( Array.map R.opp w )
 | Sparse_vector w -> Sparse_vector ( V.opp w ) ;;

(** 
vector_eq_zero vector
*)

let vector_eq_zero = function (v:vector) ->
 match v with
 | Full_vector w -> Util.array_eq_zero R.eq_zero w
 | Sparse_vector w -> V.eq_zero w ;;


(** 
vector_in_place_add vector1 vector2
The first vector stores the result.

Le premier vecteur accueille le résultat. *)


let vector_in_place_add = fun (v:vector) (w:vector) ->
 if not ( vector_eq_zero w ) then
  begin
   match v with
   | Full_vector x ->
    begin
     match w with
     | Full_vector y ->
      begin
       let d = min ( Array.length x ) ( Array.length y ) in
        for i = 0 to pred d do
         x.(i) <- R.add x.(i) y.(i)
        done ;
      end
     | Sparse_vector y ->
      begin
       let f = function ( i , z ) -> x.(i) <- R.add x.(i) z in
        V.iter f y
      end
    end
   | Sparse_vector x ->
    begin
     match w with
     | Full_vector y ->
      begin
       for i = 0 to pred ( Array.length y ) do
        V.insert_add y.(i) i x
       done
      end
     | Sparse_vector y -> V.in_place_add x y
    end
  end ;;

(** 
vector_add vector1 vector2
*)

let rec vector_add = fun (v:vector) (w:vector) ->
 match v with
 | Full_vector x ->
  begin
   match w with
   | Full_vector y ->
    begin
     let d = Array.length x in
      assert ( d = Array.length y ) ;
      let result = array_null d in
       for i = 0 to pred d do
        result.(i) <- R.add x.(i) y.(i)
       done ;
       Full_vector result
    end
   | Sparse_vector y ->
    begin
     let d = Array.length x in
      assert ( d = V.dimension y ) ;
      let result = Array.map R.copy x in
       let f = function ( i , z ) -> result.(i) <- R.add x.(i) z in
        V.iter f y ;
        Full_vector result
    end
  end
 | Sparse_vector x ->
  begin
   match w with
   | Full_vector y -> vector_add w v
   | Sparse_vector y -> Sparse_vector ( V.add x y )
  end ;;


(** 
vector_in_place_sub vector1 vector2
The first vector stores the result.

Le premier vecteur accueille le résultat. *)


let vector_in_place_sub = fun (v:vector) (w:vector) ->
 if not ( vector_eq_zero w ) then
  begin
   match v with
   | Full_vector x ->
    begin
     match w with
     | Full_vector y ->
      begin
       let d = min ( Array.length x ) ( Array.length y ) in
        for i = 0 to pred d do
         x.(i) <- R.sub x.(i) y.(i)
        done ;
      end
     | Sparse_vector y ->
      begin
       let f = function ( i , z ) -> x.(i) <- R.sub x.(i) z in
        V.iter f y
      end
    end
   | Sparse_vector x ->
    begin
     match w with
     | Full_vector y ->
      begin
       for i = 0 to pred ( Array.length y ) do
        V.insert_sub y.(i) i x
       done
      end
     | Sparse_vector y -> V.in_place_sub x y
    end
  end ;;

(** 
vector_sub vector1 vector2
*)

let vector_sub = fun (v:vector) (w:vector) ->
 match v with
 | Full_vector x ->
  begin
   match w with
   | Full_vector y ->
    begin
     let d = Array.length x in
      assert ( d = Array.length y ) ;
      let result = array_null d in
       for i = 0 to pred d do
        result.(i) <- R.sub x.(i) y.(i)
       done ;
       Full_vector result
    end
   | Sparse_vector y ->
    begin
     let d = Array.length x in
      assert ( d = V.dimension y ) ;
      let result = Array.map R.copy x in
       let f = function ( i , z ) -> result.(i) <- R.sub x.(i) z in
        V.iter f y ;
        Full_vector result
    end
  end
 | Sparse_vector x ->
  begin
   match w with
   | Full_vector y ->
    begin
     let d = Array.length y in
      assert ( d = V.dimension x ) ;
      let result = Array.map R.opp y in
       let f = function ( i , z ) -> result.(i) <- R.add y.(i) z in
        V.iter f x ;
        Full_vector result
    end
   | Sparse_vector y -> Sparse_vector ( V.sub x y )
  end ;;

(** 
vector_eq vector1 vector2
*)

let vector_eq = fun (v:vector) (w:vector) ->
 match v with
 | Full_vector x ->
  begin
   match w with
   | Full_vector y -> Util.array_eq R.eq x y
   | Sparse_vector y -> vector_eq_zero ( vector_sub v w )
  end
 | Sparse_vector x ->
  begin
   match w with
   | Full_vector y -> vector_eq_zero ( vector_sub w v )
   | Sparse_vector y -> V.eq x y
  end ;;

(** 
vector_sum vector
*)

let vector_sum = function (v:vector) ->
 match v with
 | Full_vector w -> Array.fold_left R.add ( R.zero () ) w
 | Sparse_vector w -> V.sum w ;;

(** 
vector_contraction init vector
*)

let vector_contraction = fun (init:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Array.fold_left R.mult init w
 | Sparse_vector w -> V.contraction init w ;;

(** 
vector_in_place_scal_add scalar vector
*)

let vector_in_place_scal_add = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Array.iteri ( fun i x -> w.(i) <- R.add y x ) w
 | Sparse_vector w -> V.in_place_scal_add y w ;;

(** 
vector_scal_add scalar vector
*)

let vector_scal_add = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Full_vector ( Array.map ( R.add y ) w )
 | Sparse_vector w -> Sparse_vector ( V.scal_add y w ) ;;

(** 
vector_in_place_scal_right_sub scalar vector
*)

let vector_in_place_scal_right_sub = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Array.iteri ( fun i x -> w.(i) <- R.sub y x ) w
 | Sparse_vector w -> V.in_place_scal_right_sub y w ;;

(** 
vector_in_place_scal_left_sub scalar vector
*)

let vector_in_place_scal_left_sub = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Array.iteri ( fun i x -> w.(i) <- R.sub x y ) w
 | Sparse_vector w -> V.in_place_scal_left_sub y w ;;

(** 
vector_scal_right_sub scalar vector
*)

let vector_scal_right_sub = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Full_vector ( Array.map ( R.sub y ) w )
 | Sparse_vector w -> Sparse_vector ( V.scal_right_sub y w ) ;;

(** 
vector_scal_left_sub scalar vector
*)

let vector_scal_left_sub = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Full_vector ( Array.map ( function x -> R.sub x y ) w )
 | Sparse_vector w -> Sparse_vector ( V.scal_left_sub y w ) ;;

(** 
vector_in_place_scal_mult scalar vector
*)

let vector_in_place_scal_mult = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Array.iteri ( fun i x -> w.(i) <- R.mult y x ) w
 | Sparse_vector w -> V.in_place_scal_mult y w ;;

(** 
vector_scal_mult scalar vector
*)

let vector_scal_mult = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Full_vector ( Array.map ( R.mult y ) w )
 | Sparse_vector w -> Sparse_vector ( V.scal_mult y w ) ;;

(** 
vector_coeff_prod vector1 vector2
*)

let rec vector_coeff_prod = fun (v:vector) (w:vector) ->
 match v with
 | Full_vector x ->
  begin
   match w with
   | Full_vector y ->
    begin
     let d = Array.length x in
      assert ( d = Array.length y ) ;
      let result = array_null d in
       for i = 0 to pred d do
        result.(i) <- R.mult x.(i) y.(i)
       done ;
       Full_vector result
    end
   | Sparse_vector y ->
    begin
     let d = Array.length x in
      assert ( d = V.dimension y ) ;
      let result = V.null d in
       let f = function ( i , z ) -> V.insert_add ( R.mult x.(i) z ) i result in
        V.iter f y ;
        Sparse_vector result
    end
  end
 | Sparse_vector x ->
  begin
   match w with
   | Full_vector y -> vector_coeff_prod w v
   | Sparse_vector y -> Sparse_vector ( V.coeff_prod x y )
  end ;;

(** 
vector_scal_prod vector1 vector2
*)

let vector_scal_prod = fun (v:vector) (w:vector) ->
 match v with
 | Full_vector x ->
  begin
   match w with
   | Full_vector y ->
    begin
     let d = min ( Array.length x ) ( Array.length y ) in
      let z = ref ( R.zero () ) in
       for i = 0 to pred d do
        z := R.add !z ( R.mult x.(i) y.(i) )
       done ;
       !z
    end
   | Sparse_vector y -> V.sparse_full_scal_prod y x
  end
 | Sparse_vector x ->
  begin
   match w with
   | Full_vector y -> V.sparse_full_scal_prod x y
   | Sparse_vector y -> V.scal_prod x y
  end ;;

(** 
vector_norm_1 vector
*)

let vector_norm_1 = function (v:vector) ->
 match v with
 | Full_vector w -> Array.fold_left R.norm_add ( R.norm_zero () ) ( Array.map R.norm w )
 | Sparse_vector w -> V.norm_1 w ;;

(** 
vector_norm_inf vector
*)

let vector_norm_inf = function (v:vector) ->
 match v with
 | Full_vector w -> Util.array_maximum R.norm_compare ( Array.map R.norm w )
 | Sparse_vector w -> V.norm_inf w ;;

(** 
vector_square_norm_2 vector
*)

let vector_square_norm_2 = function (v:vector) ->
 match v with
 | Full_vector w ->
  begin
   let f = function x -> R.norm ( R.mult x x ) in
    Array.fold_left R.norm_add ( R.norm_zero () ) ( Array.map f w )
  end
 | Sparse_vector w -> V.square_norm_2 w ;;

(** 
vector_square_sum vector
*)

let vector_square_sum = function (v:vector) ->
 vector_scal_prod v v ;;

(** 
vector_compare_norm norm vector1 vector2
*)

let vector_compare_norm = fun n (v:vector) (w:vector) ->
 R.norm_compare ( n v ) ( n w ) ;;

(** 
vector_compare vector1 vector2
*)

let vector_compare = vector_compare_norm vector_norm_inf ;;

(** 
vector_int_mult integer vector
*)

let vector_int_mult = fun (n:int) (v:vector) ->
 vector_map ( function x -> R.int_mult n x ) v ;;

(** 
vector_int_pow integer vector
*)

let vector_int_pow = fun (n:int) (v:vector) ->
 vector_map ( function x -> R.int_pow n x ) v ;;

(** 
vector_norm_inject number
*)

let vector_norm_inject = function (x:R.u) ->
 Full_vector [| R.norm_inject x |] ;;


(** 
vector_of_blocks block_array
If one of the vectors is full, then so is the result. If all are sparse, then so is the result.

Si l'un des vecteurs est plein, alors le résultat l'est. Si tous sont creux, alors le résultat l'est. *)


let vector_of_blocks = function (x:vector array) ->
 let lengths = Array.map vector_dimension x in
  let dim = Array.fold_left ( + ) 0 lengths
  and shifts = Array.append [| 0 |] lengths in
   for i = 0 to pred ( Array.length x ) do
    shifts.( succ i ) <- shifts.(i) + lengths.(i)
   done ;
    let g = fun i z -> vector_embed dim shifts.(i) z in
     let xx = Array.mapi g x
     and zz = vector_sparse_null dim in
      Array.fold_left vector_add zz xx ;;




(**
§
*)

(**

Tenseurs

Tensors

 *)

(**
*)





(** The type tensor gathers all formats of tensors with coefficients of type coeff.

Le type tensor rassemble tous les formats de tenseurs à coefficients de type coeff. *)


type tensor =
 | Sparse_tensor of T.t
 | Vector of vector
 | Full_tensor of tensor array ;;


(** 
tensor_copy tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_copy = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> Sparse_tensor ( T.copy x )
 | Vector x -> Vector ( vector_copy x )
 | Full_tensor x -> Full_tensor ( Array.map tensor_copy x ) ;;


(** 
tensor_resize size tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_resize = fun (n:int) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.resize n x
 | Vector x -> vector_resize n x
 | Full_tensor x -> Array.iter ( tensor_resize n ) x ;;


(** 
thickness tensor
The thickness represents the predecessor of the number of variables or of the degree of the tensor. This function is not tail recursive.

Cette fonction n'est pas récursive terminale. L'épaisseur représente le prédécesseur du nombre de variables ou du degré du tenseur.*)


let rec thickness = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.thickness x
 | Vector x -> 0
 | Full_tensor x ->
  begin
   let t = Array.map thickness x in
    succ ( Util.array_maximum compare t )
  end ;;


(** The three following functions are not sealed.

Les trois fonctions suivantes ne sont pas étanches. *)




(** 
tensor_sparse_demakeup tensor
*)

let tensor_sparse_demakeup = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> x
 | Vector x -> failwith "Vector instead of a sparse tensor in Mat.tensor_sparse_demakeup."
 | Full_tensor x -> failwith "Full_tensor instead of a sparse tensor in Mat.tensor_sparse_demakeup." ;;

(** 
tensor_vector_demakeup tensor
*)

let tensor_vector_demakeup = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> failwith "Sparse tensor instead of a vector in Mat.tensor_vector_demakeup."
 | Vector x -> x
 | Full_tensor x -> failwith "Full_tensor instead of a vector in Mat.tensor_vector_demakeup." ;;

(** 
tensor_full_demakeup tensor
*)

let tensor_full_demakeup = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> failwith "Sparse_tensor instead of a full thick tensor in Mat.tensor_full_demakeup."
 | Vector x -> failwith "Vector instead of a full thick tensor in Mat.tensor_full_demakeup."
 | Full_tensor x -> x ;;


(** 
tensor_full_null dimensions
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_full_null = function (dims:int array) ->
 match Array.length dims with
 | 0 -> Vector ( Full_vector ( Array.make 0 ( R.zero () ) ) )
 | 1 -> Vector ( Full_vector ( array_null dims.(0) ) )
 | _ -> Full_tensor ( Array.map tensor_full_null ( Array.make dims.(0) ( Util.array_tail dims ) ) ) ;;

(** 
tensor_sparse_null dimensions
*)

let tensor_sparse_null = function (dims:int array) ->
 Sparse_tensor ( T.null dims ) ;;

(** 
tensor_null dimensions
*)

let tensor_null = tensor_sparse_null ;;

(** 
tensor_zero unit
*)

let tensor_zero = function () ->
 tensor_sparse_null [| 0 |] ;;

(** 
tensor_eq_zero tensor
*)

let rec tensor_eq_zero = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.eq_zero x
 | Vector x -> vector_eq_zero x
 | Full_tensor x -> Util.array_eq_zero tensor_eq_zero x ;;


(** 
tensor_dimensions tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_dimensions = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.dimensions x
 | Vector x -> [| vector_dimension x |]
 | Full_tensor x ->
  begin
   let t = Array.map tensor_dimensions x in
    let tt = Util.array_maximum ( Util.lexico_compare compare ) t in
     Array.append [| Array.length x |] tt
  end ;;


(** 
tensor_nihil dimensions
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_nihil = function (v:tensor) ->
 match v with
 | Sparse_tensor x ->
  begin
   let z = T.null ( T.dimensions x ) in
    T.resize ( T.size x ) z ;
    Sparse_tensor ( z )
  end
 | Vector x -> Vector ( vector_nihil x )
 | Full_tensor x -> Full_tensor ( Array.map tensor_nihil x ) ;;

(** 
tensor_filling tensor
*)

let tensor_filling = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.filling x
 | Vector x -> vector_filling x
 | Full_tensor x -> failwith "Full vector in Mat.tensor_filling." ;;

(** 
tensor_sizes tensor
*)

let tensor_sizes = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.sizes x
 | Vector x -> failwith "Vector tensor in Mat.tensor_sizes."
 | Full_tensor x -> failwith "Full vector in Mat.tensor_sizes." ;;


(** 
tensor_to_sparse tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_to_sparse = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> v
 | Vector x -> Sparse_tensor ( T.Vector ( vector_sparse_demakeup ( vector_to_sparse x ) ) )
 | Full_tensor x ->
  begin
   let d = tensor_dimensions v in
    let result = T.null d in
     let f = fun i y ->
      begin
       let yy = tensor_sparse_demakeup ( tensor_to_sparse y )
       and g = function ( j , z ) -> T.insert_add z ( Array.append [| i |] j ) result in
        T.iter g yy
      end in
      Array.iteri f x ;
      Sparse_tensor result
  end ;;


(** 
tensor_extract indices tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_extract = fun (i:int array) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.raw_extract i x
 | Vector x -> vector_extract i.(0) x
 | Full_tensor x ->
  begin
   let z = x.( i.(0) )
   and j = Util.array_tail i in
    tensor_extract j z
  end ;;


(** 
sub_tensor_extract level index tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec sub_tensor_extract = fun (level:int) (i:int) (v:tensor) ->
 match v with
 | Sparse_tensor x -> Sparse_tensor ( T.sub_tensor_extract level i x )
 | Vector x ->
  begin
   assert ( level = 0 ) ;
   Vector ( Full_vector [| vector_extract i x |] )
  end
 | Full_tensor x ->
  begin
   if level = 0 then
    x.(i)
   else
    Full_tensor ( Array.map ( sub_tensor_extract ( pred level ) i ) x )
  end ;;


(** 
tensor_insert_add coefficient indices tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_insert_add = fun (y:coeff) (i:int array) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.insert_add y i x
 | Vector x -> vector_insert_add y i.(0) x
 | Full_tensor x -> tensor_insert_add y ( Util.array_tail i ) x.(i.(0)) ;;


(** 
tensor_insert_sub coefficient indices tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_insert_sub = fun (y:coeff) (i:int array) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.insert_sub y i x
 | Vector x -> vector_insert_sub y i.(0) x
 | Full_tensor x -> tensor_insert_sub y ( Util.array_tail i ) x.(i.(0)) ;;


(** 
tensor_remove indices tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_remove = fun (i:int array) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.remove i x
 | Vector x -> vector_remove i.(0) x
 | Full_tensor x -> tensor_remove ( Util.array_tail i ) x.(i.(0)) ;;


(** 
sub_tensor_remove level index tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec sub_tensor_remove = fun (level:int) (i:int) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.sub_tensor_remove level i x
 | Vector x ->
  begin
   assert ( level = 0 ) ;
   vector_remove i x
  end
 | Full_tensor x ->
  begin
   if level = 0 then
    begin
     let d = tensor_dimensions v in
      x.(i) <- tensor_sparse_null ( Util.array_tail d )
    end
   else
    Array.iter ( sub_tensor_remove ( pred level ) i ) x
  end ;;


(** 
tensor_replace indices tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_replace = fun (y:coeff) (i:int array) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.replace y i x
 | Vector x -> vector_replace y i.(0) x
 | Full_tensor x -> tensor_replace y ( Util.array_tail i ) x.(i.(0)) ;;


(** 
sub_tensor_replace level index tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec sub_tensor_replace = fun (y:tensor) (level:int) (i:int) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.sub_tensor_replace ( tensor_sparse_demakeup ( tensor_to_sparse y ) ) level i x
 | Vector x -> failwith "Vector argument in Mat.sub_tensor_replace."
 | Full_tensor x ->
  begin
   if level = 0 then
    x.(i) <- y
   else
    Array.iter ( sub_tensor_replace y ( pred level ) i ) x
  end ;;


(** 
tensor_to_full tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_to_full = function (v:tensor) ->
 match v with
 | Full_tensor x -> v
 | Vector x -> Vector ( vector_to_full x )
 | Sparse_tensor x ->
  begin
   let d = T.dimensions x in
    let e = pred ( Array.length d ) in
     let result = ref ( Vector ( Full_vector ( array_null d.(e) ) ) ) in
      for i = pred e downto 0 do
       result := Full_tensor ( Array.map tensor_copy ( Array.make d.(i) !result ) )
      done ;
       let f = fun ( i , y ) ->
        begin
         tensor_insert_add y i !result
        end in
       T.iter f x ;
       !result
  end ;;

(** 
tensor_to_vector tensor
*)

let tensor_to_vector = function (v:tensor) ->
 match v with
 | Vector x -> v
 | Sparse_tensor x -> Vector ( Sparse_vector ( T.vector_demakeup ( T.tensor_to_vector x ) ) )
 | Full_tensor x -> failwith "Full_tensor in Mat.tensor_to_vector." ;;

(** 
tensor_quality tensor
*)

let rec tensor_quality = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> "Sparse tensor"
 | Vector x -> "Vector tensor"
 | Full_tensor x -> "Full tensor" ;;


(** 
tensor_to_string tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_to_string = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> "Sparse_tensor " ^ ( T.to_string x )
 | Vector x -> "Vector " ^ ( vector_to_string x )
 | Full_tensor x ->
  begin
   let e = string_of_int ( thickness v ) in
    let beginning = "[" ^ e ^ "|"
    and ending = "|" ^ e ^ "]"
    and separator = "°" ^ e ^ "°" in
     let s = Util.vector_to_string tensor_to_string beginning separator ending x in
      "Full_tensor" ^ e ^ " " ^ s
  end ;;


(** 
tensor_of_string string
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_of_string = function (s:string) ->
 let lst = String.length s
 and index = Str.search_forward ( Str.regexp " " ) s 0 in
  let qualif = String.sub s 0 index
  and rest = String.sub s ( succ index ) ( lst - index - 1 ) in
   match qualif with
   | "Vector" -> Vector ( vector_of_string rest )
   | "Sparse_tensor" -> Sparse_tensor ( T.of_string rest )
   | _ ->
    begin
     match ( String.sub qualif 0 11 ) with
     | "Full_vector" ->
      let e = String.sub qualif 11 ( String.length qualif - 11 ) in
       let beginning = "[" ^ e ^ "|"
       and ending = "|" ^ e ^ "]"
       and separator = "°" ^ e ^ "°" in
        Full_tensor ( Util.vector_of_string tensor_of_string beginning separator ending rest )
     | _ -> failwith "Not a valid string in Mat.tensor_of_string."
    end ;;


(** 
tensor_find coefficient tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_find = fun (y:coeff) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.find y x
 | Vector x -> [| vector_find y x |]
 | Full_tensor x ->
  begin
   let i = ref 0
   and e = thickness v
   and r = Array.length x in
    let index = Array.make ( succ e ) ( -1 ) in
     while !i < r do
      let j = tensor_find y x.(!i) in
       if j.(0) >= 0 then
        begin
         index.(0) <- !i ;
         for k = 1 to e do
          index.(k) <- j.( pred k )
         done ;
         i := r ;
        end
       else
        incr i ;
     done ;
     index
  end ;;


(** 
tensor_find_all coefficient tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_find_all = fun (y:coeff) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.index_list_find_all y x
 | Vector x -> List.rev_map ( Array.make 1 ) ( vector_list_find_all y x )
 | Full_tensor x ->
  begin
   let result = ref []
   and r = Array.length x in
    for i = 0 to pred r do
     let j = tensor_find_all y x.(i) in
      if Util.list_non_empty j then
       begin
        let jj = List.rev_map ( Array.append [| i |] ) j in
         result := List.rev_append jj !result
       end ;
    done ;
    !result
  end ;;


(** 
tensor_filter predicate tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_filter = fun (p:index array -> bool) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.filter p x
 | Vector x ->
  begin
   let pp = function i -> p [| i |]
   and f = function ( i , y ) -> ( [| i |] , y )  in
    let result = vector_filter pp x in
     List.rev_map f result
  end
 | Full_tensor x ->
  begin
   let result = ref []
   and r = Array.length x in
    for i = 0 to pred r do
     let pp = function k -> p ( Array.append [| i |] k )
     and f = function ( k , y ) -> ( Array.append [| i |] k , y ) in
      let j = tensor_filter pp x.(i) in
       if Util.list_non_empty j then
        begin
         let jj = List.rev_map f j in
          result := List.rev_append jj !result
        end ;
    done ;
    !result
  end ;;


(** 
tensor_opp tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_opp = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> Sparse_tensor ( T.opp x )
 | Vector x -> Vector ( vector_opp x )
 | Full_tensor x -> Full_tensor ( Array.map tensor_opp x ) ;;


(** 
tensor_iter function tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_iter = fun f (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.iter f x
 | Vector x ->
  begin
   let g = function ( i , y ) -> f ( [| i |] , y ) in
    vector_iter g x
  end
 | Full_tensor x -> Array.iter ( tensor_iter f ) x ;;


(** 
tensor_fold function tensor init
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_fold = fun f (v:tensor) init ->
 match v with
 | Sparse_tensor x -> T.fold f x init
 | Vector x ->
  begin
   let g = fun ( i , y ) z -> f ( [| i |] , y ) z in
    vector_fold g x init
  end
 | Full_tensor x ->
  begin
   let g = fun z y -> tensor_fold f y z in
    Array.fold_left g init x
  end ;;


(** 
tensor_in_place_map function tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_in_place_map = fun f (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.in_place_map f x
 | Vector x -> vector_in_place_map f x
 | Full_tensor x -> Array.iter ( tensor_in_place_map f ) x ;;


(** 
tensor_in_place_mapi function tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_in_place_mapi = fun f (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.in_place_mapi f x
 | Vector x ->
  begin
   let g = fun i y -> f [| i |] y in
    vector_in_place_mapi g x
  end
 | Full_tensor x ->
  begin
   let g = fun i y ->
    begin
     let ff = fun j z -> f ( Array.append [| i |] j ) z in
      tensor_in_place_mapi ff y
    end in
    Array.iteri g x
  end ;;


(** 
tensor_map function tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_map = fun f (v:tensor) ->
 match v with
 | Sparse_tensor x -> Sparse_tensor ( T.map f x )
 | Vector x -> Vector ( vector_map f x )
 | Full_tensor x -> Full_tensor ( Array.map ( tensor_map f ) x ) ;;


(** 
tensor_mapi function tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_mapi = fun f (v:tensor) ->
 match v with
 | Sparse_tensor x -> Sparse_tensor ( T.mapi f x )
 | Vector x ->
  begin
   let g = fun i y -> f [| i |] y in
     Vector ( vector_mapi g x )
  end
 | Full_tensor x -> Full_tensor ( Array.map ( tensor_mapi f ) x ) ;;


(** 
tensor_minimum tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_minimum = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.min x
 | Vector x -> vector_minimum x
 | Full_tensor x -> Util.array_minimum R.compare ( Array.map tensor_minimum x ) ;;


(** 
tensor_maximum tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_maximum = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.max x
 | Vector x -> vector_maximum x
 | Full_tensor x -> Util.array_maximum R.compare ( Array.map tensor_maximum x ) ;;


(** 
tensor_in_place_add function scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_in_place_add = fun (v:tensor) (w:tensor) ->
 match ( v , w ) with
 | ( Sparse_tensor x , Sparse_tensor y ) -> T.in_place_add x y
 | ( Sparse_tensor x , _ ) -> tensor_in_place_add v ( tensor_to_sparse w )
 | ( Vector x , Vector y ) -> vector_in_place_add x y
 | ( Vector x , Sparse_tensor y ) -> tensor_in_place_add v ( tensor_to_vector w )
 | ( Vector x , Full_tensor y ) -> failwith "Arguments incompatibility in Mat.tensor_in_place_add."
 | ( Full_tensor x , Vector y ) -> failwith "Arguments incompatibility in Mat.tensor_in_place_add."
 | ( Full_tensor x , Sparse_tensor y ) -> tensor_in_place_add v ( tensor_to_full w )
 | ( Full_tensor x , Full_tensor y ) ->
  begin
   let f = fun i z -> tensor_in_place_add x.(i) z in
    Array.iteri f y
  end ;;


(** 
tensor_add function scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_add = fun (v:tensor) (w:tensor) ->
 match ( v , w ) with
 | ( Sparse_tensor x , Sparse_tensor y ) -> Sparse_tensor ( T.add x y )
 | ( Sparse_tensor x , Full_tensor y ) -> tensor_add ( tensor_to_full v ) w
 | ( Sparse_tensor x , Vector y ) -> tensor_add ( tensor_to_vector v ) w
 | ( Vector x , Vector y ) -> Vector ( vector_add x y )
 | ( Vector x , Sparse_tensor y ) -> tensor_add w v
 | ( Vector x , Full_tensor y ) -> failwith "Arguments incompatibility in Mat.tensor_add."
 | ( Full_tensor x , Full_tensor y ) ->
  begin
   let f = fun i z -> tensor_add x.(i) z in
    Full_tensor ( Array.mapi f y )
  end
 | ( Full_tensor x , Sparse_tensor y ) -> tensor_add v ( tensor_to_full w )
 | ( Full_tensor x , Vector y ) -> failwith "Arguments incompatibility in Mat.tensor_add." ;;


(** 
tensor_in_place_sub function scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_in_place_sub = fun (v:tensor) (w:tensor) ->
 match ( v , w ) with
 | ( Sparse_tensor x , Sparse_tensor y ) -> T.in_place_sub x y
 | ( Sparse_tensor x , _ ) -> tensor_in_place_sub v ( tensor_to_sparse w )
 | ( Vector x , Vector y ) -> vector_in_place_sub x y
 | ( Vector x , Sparse_tensor y ) -> tensor_in_place_sub v ( tensor_to_vector w )
 | ( Vector x , Full_tensor y ) -> failwith "Arguments incompatibility in Mat.tensor_in_place_sub."
 | ( Full_tensor x , Vector y ) -> failwith "Arguments incompatibility in Mat.tensor_in_place_sub."
 | ( Full_tensor x , Sparse_tensor y ) -> tensor_in_place_sub v ( tensor_to_full w )
 | ( Full_tensor x , Full_tensor y ) ->
  begin
   let f = fun i z -> tensor_in_place_sub x.(i) z in
    Array.iteri f y
  end ;;


(** 
tensor_sub function scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_sub = fun (v:tensor) (w:tensor) ->
 match ( v , w ) with
 | ( Sparse_tensor x , Sparse_tensor y ) -> Sparse_tensor ( T.sub x y )
 | ( Sparse_tensor x , Full_tensor y ) -> tensor_sub ( tensor_to_full v ) w
 | ( Sparse_tensor x , Vector y ) -> tensor_sub ( tensor_to_vector v ) w
 | ( Vector x , Vector y ) -> Vector ( vector_sub x y )
 | ( Vector x , Sparse_tensor y ) -> tensor_sub v ( tensor_to_vector w )
 | ( Vector x , Full_tensor y ) -> failwith "Arguments incompatibility in Mat.tensor_sub."
 | ( Full_tensor x , Full_tensor y ) ->
  begin
   let f = fun i z -> tensor_sub x.(i) z in
    Full_tensor ( Array.mapi f y )
  end
 | ( Full_tensor x , Sparse_tensor y ) -> tensor_sub v ( tensor_to_full w )
 | ( Full_tensor x , Vector y ) -> failwith "Arguments incompatibility in Mat.tensor_sub." ;;

(** 
tensor_eq tensor1 tensor2
*)

let tensor_eq = fun (v:tensor) (w:tensor) ->
 tensor_eq_zero ( tensor_sub v w ) ;;


(** 
tensor_sum tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_sum = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.sum x
 | Vector x -> vector_sum x
 | Full_tensor x -> Array.fold_left R.add ( R.zero () ) ( Array.map tensor_sum x ) ;;


(** 
tensor_contraction init tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_contraction = fun init (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.contraction init x
 | Vector x -> vector_contraction init x
 | Full_tensor x ->
  begin
   let accu = ref init in
    let f = function y -> accu := tensor_contraction !accu y in
     Array.iter f x ;
     !accu
  end ;;


(** 
tensor_in_place_scal_add scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_in_place_scal_add = fun s (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.in_place_scal_add s x
 | Vector x -> vector_in_place_scal_add s x
 | Full_tensor x -> Array.iter ( tensor_in_place_scal_add s ) x ;;


(** 
tensor_scal_add scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_scal_add = fun s (v:tensor) ->
 match v with
 | Sparse_tensor x -> Sparse_tensor ( T.scal_add s x )
 | Vector x -> Vector ( vector_scal_add s x )
 | Full_tensor x -> Full_tensor ( Array.map ( tensor_scal_add s ) x ) ;;


(** 
tensor_in_place_scal_mult scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_in_place_scal_mult = fun s (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.in_place_scal_mult s x
 | Vector x -> vector_in_place_scal_mult s x
 | Full_tensor x -> Array.iter ( tensor_in_place_scal_mult s ) x ;;


(** 
tensor_scal_mult scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_scal_mult = fun s (v:tensor) ->
 match v with
 | Sparse_tensor x -> Sparse_tensor ( T.scal_mult s x )
 | Vector x -> Vector ( vector_scal_mult s x )
 | Full_tensor x -> Full_tensor ( Array.map ( tensor_scal_mult s ) x ) ;;


(** 
tensor_in_place_scal_left_sub scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_in_place_scal_left_sub = fun s (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.in_place_scal_left_sub s x
 | Vector x -> vector_in_place_scal_left_sub s x
 | Full_tensor x -> Array.iter ( tensor_in_place_scal_left_sub s ) x ;;


(** 
tensor_scal_left_sub scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_scal_left_sub = fun s (v:tensor) ->
 match v with
 | Sparse_tensor x -> Sparse_tensor ( T.scal_left_sub s x )
 | Vector x -> Vector ( vector_scal_left_sub s x )
 | Full_tensor x -> Full_tensor ( Array.map ( tensor_scal_left_sub s ) x ) ;;


(** 
tensor_in_place_scal_right_sub scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_in_place_scal_right_sub = fun s (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.in_place_scal_right_sub s x
 | Vector x -> vector_in_place_scal_right_sub s x
 | Full_tensor x -> Array.iter ( tensor_in_place_scal_right_sub s ) x ;;


(** 
tensor_scal_right_sub scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_scal_right_sub = fun s (v:tensor) ->
 match v with
 | Sparse_tensor x -> Sparse_tensor ( T.scal_right_sub s x )
 | Vector x -> Vector ( vector_scal_right_sub s x )
 | Full_tensor x -> Full_tensor ( Array.map ( tensor_scal_right_sub s ) x ) ;;


(** 
tensor_coeff_prod function scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_coeff_prod = fun (v:tensor) (w:tensor) ->
 match ( v , w ) with
 | ( Sparse_tensor x , Sparse_tensor y ) -> Sparse_tensor ( T.coeff_prod x y )
 | ( Sparse_tensor x , Full_tensor y ) -> tensor_coeff_prod ( tensor_to_full v ) w
 | ( Sparse_tensor x , Vector y ) -> tensor_coeff_prod ( tensor_to_vector v ) w
 | ( Vector x , Vector y ) -> Vector ( vector_coeff_prod x y )
 | ( Vector x , Sparse_tensor y ) -> tensor_coeff_prod w v
 | ( Vector x , Full_tensor y ) -> failwith "Arguments incompatibility in Mat.tensor_coeff_prod."
 | ( Full_tensor x , Full_tensor y ) ->
  begin
   let f = fun i z -> tensor_coeff_prod x.(i) z in
    Full_tensor ( Array.mapi f y )
  end
 | ( Full_tensor x , Sparse_tensor y ) -> tensor_coeff_prod v ( tensor_to_full w )
 | ( Full_tensor x , Vector y ) -> failwith "Arguments incompatibility in Mat.tensor_coeff_prod." ;;


(** 
tensor_scal_prod function scalar tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_scal_prod = fun (v:tensor) (w:tensor) ->
 match ( v , w ) with
 | ( Sparse_tensor x , Sparse_tensor y ) -> T.scal_prod x y
 | ( Sparse_tensor x , _ ) -> tensor_scal_prod v ( tensor_to_sparse w )
 | ( Vector x , Vector y ) -> vector_scal_prod x y
 | ( Vector x , Sparse_tensor y ) -> tensor_scal_prod v ( tensor_to_vector w )
 | ( Vector x , Full_tensor y ) -> failwith "Arguments incompatibility in Mat.tensor_scal_prod."
 | ( Full_tensor x , Vector y ) -> failwith "Arguments incompatibility in Mat.tensor_scal_prod."
 | ( Full_tensor x , Sparse_tensor y ) -> tensor_scal_prod v ( tensor_to_full w )
 | ( Full_tensor x , Full_tensor y ) ->
  begin
   let f = fun i z -> tensor_scal_prod x.(i) z in
    Array.fold_left R.add ( R.zero () ) ( Array.mapi f y )
  end ;;


(** 
tensor_norm_1 tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_norm_1 = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.norm_1 x
 | Vector x -> vector_norm_1 x
 | Full_tensor x -> Array.fold_left R.norm_add ( R.norm_zero () ) ( Array.map tensor_norm_1 x ) ;;


(** 
tensor_norm_inf tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_norm_inf = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.norm_inf x
 | Vector x -> vector_norm_inf x
 | Full_tensor x -> Array.fold_left R.norm_add ( R.norm_zero () ) ( Array.map tensor_norm_inf x ) ;;


(** 
tensor_square_norm_2 tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_square_norm_2 = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.square_norm_2 x
 | Vector x -> vector_square_norm_2 x
 | Full_tensor x -> Array.fold_left R.norm_add ( R.norm_zero () ) ( Array.map tensor_square_norm_2 x ) ;;


(** 
tensor_square_sum tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_square_sum = function (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.square_sum x
 | Vector x -> vector_square_sum x
 | Full_tensor x -> Array.fold_left R.add ( R.zero () ) ( Array.map tensor_square_sum x ) ;;

(** 
tensor_compare_norm norm function scalar tensor
*)

let tensor_compare_norm = fun n (v:tensor) (w:tensor) ->
 R.norm_compare ( n v ) ( n w ) ;;


(** 
tensor_exchange level index1 index2 tensor
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_exchange = fun (level:int) (i:int) (j:int) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.exchange level i j x
 | Vector x ->
  begin
   if level <> 0 then failwith "Bad level in Mat.tensor_exchange." ;
   vector_exchange i j x
  end
 | Full_tensor x ->
  begin
   if level == 0 then
    begin
     let y = Array.map tensor_copy x in
      let z = y.(i) in
       y.(i) <- y.(j) ;
       y.(j) <- z ;
    end
   else
    Array.iter ( tensor_exchange ( pred level ) i j ) x
  end ;;


(** 
tensor_level_exchange level1 level2 tensor
*)

let tensor_level_exchange = fun (level1:int) (level2:int) (v:tensor) ->
 match v with
 | Sparse_tensor x -> T.level_exchange level1 level2 x
 | Vector x -> if ( level1 <> 0 ) || ( level2 <> 0 ) then failwith "Bad levels in Mat.tensor_level_exchange."
 | Full_tensor x -> failwith "Full tensor in Mat.tensor_level_exchange." ;;


(** 
tensor_mult tensor1 tensor2
This function is not tail recursive.

Cette fonction n'est pas récursive terminale. *)


let rec tensor_mult = fun (v:tensor) (w:tensor) ->
 match ( v , w ) with
 | ( Sparse_tensor x , Sparse_tensor y ) -> Sparse_tensor ( T.mult x y )
 | ( Sparse_tensor x , _ ) -> tensor_mult v ( tensor_to_sparse w )
 | ( Vector x , _ ) ->
  begin
   let d = tensor_dimensions w
   and r = vector_dimension x in
    let dim = Array.append [| r |] d in
     let result = tensor_null dim in
      let f = function ( i , x ) -> sub_tensor_replace ( tensor_scal_mult x w ) 0 i result in
       vector_iter f x ;
       result
  end
 | ( Full_tensor x , _ ) ->
  begin
   let f = function z -> tensor_mult z w in
    Full_tensor ( Array.map f x )
  end ;;




(**
§
*)

(**

Matrices

 *)

(**
*)





(** The matrix type gathers all formats of matrices with coefficients of type coeff.

Le type matrix rassemble tous les formats de matrices à coefficients de type coeff.*)


type matrix =
 | Full_matrix of coeff array array
 | Sparse_matrix of M.t ;;

(** 
matrix_dimensions matrix
*)

let matrix_dimensions = function (m:matrix) ->
 match m with
 | Full_matrix w -> [| Array.length w ; Array.length w.(0) |]
 | Sparse_matrix w -> M.dimensions w ;;

(** 
matrix_filling matrix
*)

let matrix_filling = function (m:matrix) ->
 match m with
 | Full_matrix w -> failwith "Full matrix in Mat.matrix_filling."
 | Sparse_matrix w -> M.filling w ;;

(** 
matrix_detailed_filling matrix
*)

let matrix_detailed_filling = function (m:matrix) ->
 match m with
 | Full_matrix w -> failwith "Full matrix in Mat.matrix_detailed_filling."
 | Sparse_matrix w -> M.detailed_filling w ;;

(** 
matrix_sizes matrix
*)

let matrix_sizes = function (m:matrix) ->
 match m with
 | Full_matrix w -> failwith "Full matrix in Mat.matrix_sizes."
 | Sparse_matrix w -> M.sizes w ;;

(** 
matrix_quality matrix
*)

let matrix_quality = function (m:matrix) ->
 match m with
 | Full_matrix w -> "Full matrix"
 | Sparse_matrix w -> "Sparse matrix" ;;

(** 
matrix_sparse_null dimensions
*)

let matrix_sparse_null = function (dims:int array) ->
 Sparse_matrix ( M.null dims ) ;;

(** 
array_array_null dimensions
*)

let array_array_null = function (dims:int array) ->
 let m = Array.make_matrix dims.(0) dims.(1) () in
  Array.map ( Array.map R.zero ) m ;;

(** 
matrix_full_null dimensions
*)

let matrix_full_null = function (dims:int array) ->
 Full_matrix ( array_array_null dims ) ;;

(** 
matrix_zero unit
*)

let matrix_zero = function () ->
 matrix_sparse_null ( Array.make 2 1 ) ;;

(** 
matrix_nihil matrix
*)

let matrix_nihil = function (m:matrix) ->
 let d = matrix_dimensions m in
  match m with
  | Full_matrix w -> matrix_full_null d
  | Sparse_matrix w -> 
   begin
    let z = M.T.null d in
     M.T.resize ( M.size w ) z ;
     Sparse_matrix ( M.Sparse_tensor_matrix z )
   end ;;

(** 
scal_matrix scalar dimension
*)

let scal_matrix = fun (x:coeff) (dim:int) ->
 let dims = Array.make 2 dim in
  let t = T.null dims in
   Sparse_matrix ( M.Diff_to_scal_matrix ( x , t ) ) ;;

(** 
matrix_copy matrix
*)

let matrix_copy = function (m:matrix) ->
 match m with
 | Full_matrix w -> Full_matrix ( Array.map ( Array.map R.copy ) w )
 | Sparse_matrix w -> Sparse_matrix ( M.copy w ) ;;

(** 
matrix_resize size matrix
*)

let matrix_resize = fun (n:int) (m:matrix) ->
 match m with
 | Full_matrix w -> ()
 | Sparse_matrix w -> M.resize n w ;;

(** 
matrix_cleanup matrix
*)

let matrix_cleanup = function (m:matrix) ->
 match m with
 | Full_matrix w -> ()
 | Sparse_matrix w -> M.cleanup w ;;

(** 
matrix_full_demakeup matrix
*)

let matrix_full_demakeup = function (m:matrix) ->
 match m with
 | Full_matrix w -> w
 | Sparse_matrix w -> failwith "Not a full matrix in Mat.matrix_full_demakeup" ;;

(** 
matrix_sparse_demakeup matrix
*)

let matrix_sparse_demakeup = function (m:matrix) ->
 match m with
 | Full_matrix w -> failwith "Not a sparse matrix in Mat.matrix_sparse_demakeup"
 | Sparse_matrix w -> w ;;

(** 
matrix_to_string matrix
*)

let rec matrix_to_string = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let g = Util.bare_vector_to_string R.to_string in
    let s = ref ( "Full_matrix {| " ^ ( g w.(0) ) )
    and f = fun x y -> ( x ^ " $ " ^ ( g y ) ) in
     s := Array.fold_left f !s ( Util.array_tail w ) ;
     !s ^ " |}"
  end
 | Sparse_matrix w -> "Sparse_matrix " ^ ( M.to_string w ) ;;

(** 
matrix_of_string string
*)

let matrix_of_string = function (s:string) ->
 let lst = String.length s
 and index = Str.search_forward ( Str.regexp_string " " ) s 0 in
  let qualif = String.sub s 0 index
  and rest = String.sub s ( succ index ) ( lst - index - 1 ) in
   match qualif with
   | "Full_matrix" ->
    begin
     let a = Util.vector_of_string ( Util.bare_vector_of_string R.of_string ) "{| " " $ " " |}" rest in
      Full_matrix a
    end
   | "Sparse_matrix" -> Sparse_matrix ( M.of_string rest )
   | _ -> failwith "Not a valid string in Mat.matrix_of_string." ;;

(** 
matrix_print matrix
*)

let matrix_print = function (m:matrix) ->
 print_string ( matrix_to_string m ) ;;


(** 
matrix_to_sparse hash_size threshold matrix
This function is not sealed.

Cette fonction n'est pas étanche. *)


let matrix_to_sparse = fun (hash_size:int) (threshold:float) (m:matrix) ->
 match m with
 | Full_matrix w -> Sparse_matrix ( M.to_sparse hash_size threshold w )
 | Sparse_matrix w -> m ;;


(** 
matrix_auto_to_sparse threshold matrix
This function is not sealed.

Cette fonction n'est pas étanche. *)


let matrix_auto_to_sparse = fun (threshold:float) (m:matrix) ->
 match m with
 | Full_matrix w -> Sparse_matrix ( M.auto_to_sparse threshold w )
 | Sparse_matrix w -> m ;;


(** 
matrix_to_full matrix
This function is not sealed.

Cette fonction n'est pas étanche. *)


let matrix_to_full = function (m:matrix) ->
 match m with
 | Full_matrix w -> m
 | Sparse_matrix w -> Full_matrix ( M.to_full w ) ;;

(** 
matrix_description_eq_zero matrix
*)

let matrix_description_eq_zero = function (m:matrix) ->
 match m with
 | Full_matrix w -> Util.array_eq_zero ( Util.array_eq_zero R.eq_zero ) w
 | Sparse_matrix w -> M.description_eq_zero w ;;

(** 
matrix_eq_zero matrix
*)

let matrix_eq_zero = function (m:matrix) ->
 match m with
 | Full_matrix w -> Util.array_eq_zero ( Util.array_eq_zero R.eq_zero ) w
 | Sparse_matrix w -> M.eq_zero w ;;

(** 
matrix_description_eq matrix1 matrix2
*)

let rec matrix_description_eq = fun (m:matrix) (p:matrix) ->
 match m with
 | Full_matrix x ->
  begin
   match p with
   | Full_matrix y -> Util.array_eq ( Util.array_eq R.eq ) x y
   | Sparse_matrix y -> matrix_description_eq m ( matrix_to_full p )
  end
 | Sparse_matrix x ->
  begin
   match p with
   | Full_matrix y -> matrix_description_eq ( matrix_to_full m ) p
   | Sparse_matrix y -> M.description_eq x y
  end ;;

(** 
matrix_eq matrix1 matrix2
*)

let rec matrix_eq = fun (m:matrix) (p:matrix) ->
 match m with
 | Full_matrix x ->
  begin
   match p with
   | Full_matrix y -> Util.array_eq ( Util.array_eq R.eq ) x y
   | Sparse_matrix y -> matrix_eq m ( matrix_to_full p )
  end
 | Sparse_matrix x ->
  begin
   match p with
   | Full_matrix y -> matrix_eq ( matrix_to_full m ) p
   | Sparse_matrix y -> M.eq x y
  end ;;

(** 
matrix_row_extract index matrix
*)

let matrix_row_extract = fun (i:int) (m:matrix) ->
 match m with
 | Full_matrix w -> Full_vector ( Array.map R.copy w.(i) ) 
 | Sparse_matrix w -> Sparse_vector ( M.row_extract i w ) ;;

(** 
matrix_column_extract index matrix
*)

let matrix_column_extract = fun (i:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w in
    let c = array_null r in
     for j = 0 to pred r do
      c.(j) <- R.copy w.(j).(i)
     done ;
     Full_vector c
  end
 | Sparse_matrix w -> Sparse_vector ( M.column_extract i w ) ;;

(** 
matrix_extract row_index column_index matrix
*)

let matrix_extract = fun (i:int) (j:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
    R.copy w.(i).(j)
  end
 | Sparse_matrix w -> M.extract i j w ;;

(** 
matrix_row_remove index matrix
*)

let matrix_row_remove = fun (i:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let row = w.(i) in
    for j = 0 to pred ( Array.length row ) do
     row.(j) <- R.zero ()
    done
  end
 | Sparse_matrix w -> M.row_remove i w ;;

(** 
matrix_column_remove index matrix
*)

let matrix_column_remove = fun (i:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w in
    for j = 0 to pred r do
     w.(j).(i) <- R.zero ()
    done ;
  end
 | Sparse_matrix w -> M.column_remove i w ;;

(** 
matrix_remove row_index column_index matrix
*)

let matrix_remove = fun (i:int) (j:int) (m:matrix) ->
 match m with
 | Full_matrix w -> w.(i).(j) <- R.zero ()
 | Sparse_matrix w -> M.remove i j w ;;

(** 
matrix_row_replace vector index matrix
*)

let matrix_row_replace = fun (x:vector) (i:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let row = w.(i) in
    for j = 0 to pred ( Array.length row ) do
     row.(j) <- vector_extract j x
    done
  end
 | Sparse_matrix w -> M.row_replace ( vector_sparse_demakeup ( vector_to_sparse x ) ) i w ;;

(** 
matrix_column_replace vector index matrix
*)

let matrix_column_replace = fun (x:vector) (i:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w in
    for j = 0 to pred r do
     w.(j).(i) <- vector_extract j x
    done ;
  end
 | Sparse_matrix w -> M.column_replace ( vector_sparse_demakeup ( vector_to_sparse x ) ) i w ;;

(** 
matrix_replace coefficient row_index column_index matrix
*)

let matrix_replace = fun (x:coeff) (i:int) (j:int) (m:matrix) ->
 match m with
 | Full_matrix w -> w.(i).(j) <- x
 | Sparse_matrix w -> M.replace x i j w ;;

(** 
matrix_row_insert_add vector index matrix
*)

let matrix_row_insert_add = fun (x:vector) (i:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let row = w.(i) in
    for j = 0 to pred ( Array.length row ) do
     row.(j) <- R.add row.(j) ( vector_extract j x )
    done
  end
 | Sparse_matrix w -> M.row_insert_add ( vector_sparse_demakeup ( vector_to_sparse x ) ) i w ;;

(** 
matrix_column_insert_add vector index matrix
*)

let matrix_column_insert_add = fun (x:vector) (i:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w in
    for j = 0 to pred r do
     w.(j).(i) <- R.add w.(j).(i) ( vector_extract j x )
    done ;
  end
 | Sparse_matrix w -> M.column_insert_add ( vector_sparse_demakeup ( vector_to_sparse x ) ) i w ;;

(** 
matrix_insert_add coefficient row_index column_index matrix
*)

let matrix_insert_add = fun (x:coeff) (i:int) (j:int) (m:matrix) ->
 match m with
 | Full_matrix w -> w.(i).(j) <- R.add w.(i).(j) x
 | Sparse_matrix w -> M.insert_add x i j w ;;

(** 
matrix_row_insert_sub vector index matrix
*)

let matrix_row_insert_sub = fun (x:vector) (i:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let row = w.(i) in
    for j = 0 to pred ( Array.length row ) do
     row.(j) <- R.sub row.(j) ( vector_extract j x )
    done
  end
 | Sparse_matrix w -> M.row_insert_sub ( vector_sparse_demakeup ( vector_to_sparse x ) ) i w ;;

(** 
matrix_column_insert_sub vector index matrix
*)

let matrix_column_insert_sub = fun (x:vector) (i:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w in
    for j = 0 to pred r do
     w.(j).(i) <- R.sub w.(j).(i) ( vector_extract j x )
    done ;
  end
 | Sparse_matrix w -> M.column_insert_sub ( vector_sparse_demakeup ( vector_to_sparse x ) ) i w ;;

(** 
matrix_insert_sub coefficient row_index column_index matrix
*)

let matrix_insert_sub = fun (x:coeff) (i:int) (j:int) (m:matrix) ->
 match m with
 | Full_matrix w -> w.(i).(j) <- R.sub w.(i).(j) x
 | Sparse_matrix w -> M.insert_sub x i j w ;;

(** 
matrix_full_diag_extract matrix
*)

let matrix_full_diag_extract = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let d = min r c in
     let ww = array_null d in
      for i = 0 to pred d do
       ww.(i) <- R.copy w.(i).(i)
      done ;
      Full_vector ww
  end
 | Sparse_matrix w -> Full_vector ( M.full_diag_extract w ) ;;

(** 
matrix_sparse_diag_extract matrix
*)

let matrix_sparse_diag_extract = function (m:matrix) ->
 match m with
 | Full_matrix w -> matrix_full_diag_extract m
 | Sparse_matrix w -> Sparse_vector ( M.sparse_diag_extract w ) ;;

(** 
matrix_diag_isolate matrix
*)

let matrix_diag_isolate = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let d = min r c
    and ww = array_null r in
     for i = 0 to pred d do
      ww.(i) <- R.copy w.(i).(i)
     done ;
     Sparse_matrix ( M.Diff_to_diag_matrix ( ww , M.T.null [| r ; c |] ) )
  end
 | Sparse_matrix w -> Sparse_matrix ( M.diag_isolate w ) ;;

(** 
matrix_out_diag_isolate matrix
*)

let matrix_out_diag_isolate = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let ww = array_array_null [| r ; c |]
    and cc = pred c in
     for i = 0 to pred r do
      let row_in = w.(i)
      and row_out = ww.(i) in
       for j = 0 to pred i do
        row_out.(j) <- R.copy row_in.(j)
       done ;
       for j = succ i to cc do
        row_out.(j) <- R.copy row_in.(j)
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.out_diag_isolate w ) ;;

(** 
matrix_upper_diag_isolate matrix
*)

let matrix_upper_diag_isolate = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let ww = array_array_null [| r ; c |]
    and cc = pred c in
     for i = 0 to pred r do
      let row_in = w.(i)
      and row_out = ww.(i) in
       for j = succ i to cc do
        row_out.(j) <- R.copy row_in.(j)
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.upper_diag_isolate w ) ;;

(** 
matrix_lower_diag_isolate matrix
*)

let matrix_lower_diag_isolate = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let ww = array_array_null [| r ; c |] in
     for i = 0 to pred r do
      let row_in = w.(i)
      and row_out = ww.(i) in
       for j = 0 to pred i do
        row_out.(j) <- R.copy row_in.(j)
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.lower_diag_isolate w ) ;;

(** 
vector_to_line_matrix vector
*)

let vector_to_line_matrix = function (v:vector) ->
 match v with
 | Sparse_vector x -> Sparse_matrix ( M.sparse_vector_to_line_matrix x )
 | Full_vector x -> Sparse_matrix ( M.sparse_vector_to_line_matrix ( V.auto_to_sparse x ) ) ;;

(** 
vector_to_square_matrix vector
*)

let vector_to_square_matrix = function (v:vector) ->
 match v with
 | Sparse_vector x -> Sparse_matrix ( M.sparse_vector_to_square_matrix x )
 | Full_vector x -> Sparse_matrix ( M.full_vector_to_square_matrix x ) ;;

(** 
matrix_in_place_transpose matrix
*)

let matrix_in_place_transpose = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0)
   and f = function x -> Vector ( Full_vector x ) in
    if r <> c then failwith "Not a square full matrix in Mat.matrix_in_place_transpose." ;
    let ww = Full_tensor ( Array.map f w ) in
     tensor_level_exchange 0 1 ww ;
     for i = 0 to pred r do
      w.(i) <- vector_full_demakeup ( vector_to_full ( tensor_vector_demakeup ( sub_tensor_extract 0 i ww ) ) )
     done
  end
 | Sparse_matrix w -> M.in_place_transpose w ;;

(** 
matrix_transpose matrix
*)

let matrix_transpose = function (m:matrix) ->
 match m with
 | Full_matrix w -> Full_matrix ( Util.transpose w )
 | Sparse_matrix w -> Sparse_matrix ( M.transpose w ) ;;

(** 
vector_to_column_matrix vector
*)

let vector_to_column_matrix = function (v:vector) ->
 match v with
 | Sparse_vector x -> Sparse_matrix ( M.sparse_vector_to_column_matrix x )
 | Full_vector x -> Sparse_matrix ( M.sparse_vector_to_column_matrix ( V.auto_to_sparse x ) ) ;;

(** 
vector_to_diag vector
*)

let vector_to_diag = function (v:vector) ->
 let w = vector_full_demakeup ( vector_to_full v ) in
  let dim = Array.length w in
   let z = M.T.null ( Array.make 2 dim ) in
    Sparse_matrix ( M.Diff_to_diag_matrix ( w , z ) ) ;;

(** 
matrix_find coefficient matrix
*)

let matrix_find = fun (x:coeff) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let i = ref 0
   and r = Array.length w
   and row = ref ( -1 )
   and column = ref ( -1 ) in
    while ( !row < 0 ) && ( !i < r ) do
     column := Util.vector_find_first R.eq x w.(!i) ;
     if !column < 0 then
      incr i
     else
      row := !i
    done ;
    [| !row ; !column |]
  end
 | Sparse_matrix w -> M.find x w ;;

(** 
masked_hor_band beginning ending matrix
*)

let masked_hor_band = fun (beginning:int) (ending:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let cc = pred c
    and ww = array_array_null [| r ; c |] in
     for i = beginning to ending do
      let row_output = ww.(i)
      and row_input = w.(i) in
       for j = 0 to cc do
        row_output.(j) <- R.copy row_input.(j)
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.masked_hor_band beginning ending w ) ;;

(** 
masked_vert_band beginning ending matrix
*)

let masked_vert_band = fun (beginning:int) (ending:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let rr = pred r
    and ww = array_array_null [| r ; c |] in
     for i = 0 to rr do
      let row_output = ww.(i)
      and row_input = w.(i) in
       for j = beginning to ending do
        row_output.(j) <- R.copy row_input.(j)
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.masked_vert_band beginning ending w ) ;;

(** 
masked_head vert_ending hor_ending matrix
*)

let rec masked_head = fun (vert_ending:int) (hor_ending:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let ww = array_array_null [| r ; c |] in
     for i = 0 to vert_ending do
      let row_output = ww.(i)
      and row_input = w.(i) in
       for j = 0 to hor_ending do
        row_output.(j) <- R.copy row_input.(j)
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.masked_head vert_ending hor_ending w ) ;;

(** 
masked_tail beginning ending matrix
*)

let masked_tail = fun (vert_beginning:int) (hor_beginning:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let rr = pred r
    and cc = pred c
    and ww = array_array_null [| r ; c |] in
     for i = vert_beginning to rr do
      let row_output = ww.(i)
      and row_input = w.(i) in
       for j = hor_beginning to cc do
        row_output.(j) <- R.copy row_input.(j)
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.masked_tail vert_beginning hor_beginning w ) ;;

(** 
masked_sample
*)

let rec masked_sample = fun (vert_beginning:int) (vert_ending:int) (hor_beginning:int) (hor_ending:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let ww = array_array_null [| r ; c |] in
     for i = vert_beginning to vert_ending do
      let row_output = ww.(i)
      and row_input = w.(i) in
       for j = hor_beginning to hor_ending do
        row_output.(j) <- R.copy row_input.(j)
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.masked_sample vert_beginning vert_ending hor_beginning hor_ending w ) ;;

(** 
hor_band beginning ending matrix
*)

let hor_band = fun (beginning:int) (ending:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let c = Array.length w.(0) in
    let cc = pred c
    and ww = array_array_null [| ending - beginning + 1 ; c |] in
     for i = beginning to ending do
      let row_output = ww.( i - beginning )
      and row_input = w.(i) in
       for j = 0 to cc do
        row_output.(j) <- R.copy row_input.(j)
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.hor_band beginning ending w ) ;;

(** 
vert_band beginning ending matrix
*)

let vert_band = fun (beginning:int) (ending:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w in
    let rr = pred r
    and ww = array_array_null [| r ; ending - beginning + 1 |] in
     for i = 0 to rr do
      let row_output = ww.(i)
      and row_input = w.(i) in
       for j = beginning to ending do
        row_output.( j - beginning ) <- R.copy row_input.(j)
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.vert_band beginning ending w ) ;;

(** 
head vert_ending hor_ending matrix
*)

let rec head = fun (vert_ending:int) (hor_ending:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let ww = array_array_null [| vert_ending + 1 ; hor_ending + 1 |] in
    for i = 0 to vert_ending do
     let row_output = ww.(i)
     and row_input = w.(i) in
      for j = 0 to hor_ending do
       row_output.(j) <- R.copy row_input.(j)
      done ;
    done ;
    Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.head vert_ending hor_ending w ) ;;

(** 
tail beginning ending matrix
*)

let tail = fun (vert_beginning:int) (hor_beginning:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let rr = pred r
    and cc = pred c
    and ww = array_array_null [| r - vert_beginning + 1 ; c - hor_beginning + 1 |] in
     for i = vert_beginning to rr do
      let row_output = ww.( i - vert_beginning )
      and row_input = w.(i) in
       for j = hor_beginning to cc do
        row_output.( j - hor_beginning ) <- R.copy row_input.(j)
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.tail vert_beginning hor_beginning w ) ;;

(** 
sample
*)

let rec sample = fun (vert_beginning:int) (vert_ending:int) (hor_beginning:int) (hor_ending:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let ww = array_array_null [| vert_ending - vert_beginning + 1 ; hor_ending - hor_beginning + 1 |] in
    for i = vert_beginning to vert_ending do
     let row_output = ww.( i - vert_beginning )
     and row_input = w.(i) in
      for j = hor_beginning to hor_ending do
       row_output.( j - hor_beginning ) <- R.copy row_input.(j)
      done ;
    done ;
    Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.sample vert_beginning vert_ending hor_beginning hor_ending w ) ;;

(** 
matrix_iter function matrix
*)

let matrix_iter = fun f (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let rr = pred r
    and cc = pred c in
     for i = 0 to rr do
      let row = w.(i) in
       for j = 0 to cc do
        f ( [| i ; j |] , row.(j) )
       done ;
    done ;
  end
 | Sparse_matrix w -> M.iter f w ;;

(** 
matrix_row_exchange index1 index2 matrix
*)

let matrix_row_exchange = fun (i:int) (j:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let row = w.(i) in
    w.(i) <- w.(j) ;
    w.(j) <- row ;
  end
 | Sparse_matrix w -> M.row_exchange i j w ;;

(** 
matrix_column_exchange index1 index2 matrix
*)

let matrix_column_exchange = fun (i:int) (j:int) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and accu = ref ( R.zero () ) in
    for k = 0 to pred r do
     let row = w.(k) in
      accu := row.(i) ;
      row.(i) <- row.(j) ;
      row.(j) <- !accu ;
    done ;
  end
 | Sparse_matrix w -> M.column_exchange i j w ;;

(** 
matrix_in_place_map function matrix
*)

let matrix_in_place_map = fun f (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let rr = pred ( Array.length w )
   and cc = pred ( Array.length w.(0) ) in
    for i = 0 to rr do
     let row = w.(i) in
      for j = 0 to cc do
       row.(j) <- f row.(j) ;
      done ;
    done ;
  end
 | Sparse_matrix w -> M.in_place_map f w ;;

(** 
matrix_map function matrix
*)

let matrix_map = fun f (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and c = Array.length w.(0) in
    let ww = array_array_null [| r ; c |]
    and rr = pred r
    and cc = pred c in
     for i = 0 to rr do
      let row_output = ww.(i)
      and row_input = w.(i) in
       for j = 0 to cc do
        row_output.(j) <- f row_input.(j) ;
       done ;
     done ;
     Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.map f w ) ;;


(** 
matrix_in_place_opp matrix
*)

let matrix_in_place_opp = fun (m:matrix) ->
 matrix_in_place_map R.opp m ;;

(** 
matrix_opp matrix
*)

let matrix_opp = fun (m:matrix) ->
 matrix_map R.opp m ;;

(** 
matrix_embed dimensions shifts matrix
*)

let matrix_embed = fun (dimensions:int array) (shifts:int array) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let ww = array_array_null dimensions
   and v_shift = shifts.(0)
   and h_shift = shifts.(1)
   and p_width = pred ( Array.length w.(0) ) in
    for i = 0 to pred ( Array.length w ) do
     let row_in = w.(i)
     and row_out = ww.( v_shift + i ) in
      for j = 0 to p_width do
       row_out.( h_shift + j ) <- R.copy row_in.(j)
      done ;
    done ;
    Full_matrix ww
  end
 | Sparse_matrix w -> Sparse_matrix ( M.embed dimensions shifts w ) ;;

(** 
matrix_row_fold function init matrix
*)

let matrix_row_fold = fun (f:coeff -> vector -> coeff) (init:vector) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w in
    let x = array_null r in
     for i = 0 to pred r do
      x.(i) <- f ( vector_extract i init ) ( Full_vector w.(i) )
     done ;
     Full_vector x
  end
 | Sparse_matrix w ->
  begin
   match init with
   | Sparse_vector initial ->
    begin
     let ff = fun initialization x -> f initialization ( Sparse_vector x ) in
      Sparse_vector ( M.sparse_row_fold ff initial w )
    end
   | Full_vector initial ->
    begin
     let ff = fun initialization x -> f initialization ( Sparse_vector x ) in
      Full_vector ( M.full_row_fold ff initial w )
    end
  end ;;

(** 
matrix_column_fold function init matrix
*)

let matrix_column_fold = fun (f:coeff -> vector -> coeff) (init:vector) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let c = Array.length w.(0) in
    let x = array_null c in
     for i = 0 to pred c do
      x.(i) <- f ( vector_extract i init ) ( matrix_column_extract i m )
     done ;
     Full_vector x
  end
 | Sparse_matrix w ->
  begin
   match init with
   | Sparse_vector initial ->
    begin
     let ff = fun initialization x -> f initialization ( Sparse_vector x ) in
      Sparse_vector ( M.sparse_column_fold ff initial w )
    end
   | Full_vector initial ->
    begin
     let ff = fun initialization x -> f initialization ( Sparse_vector x ) in
      Full_vector ( M.full_column_fold ff initial w )
    end
  end ;;

(** 
matrix_row_sum matrix
*)

let matrix_row_sum = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let f = function x -> vector_sum ( Full_vector x ) in
    Full_vector ( Array.map f w )
  end
 | Sparse_matrix w ->
  match w with
  | M.Sparse_tensor_matrix t -> Sparse_vector ( M.sparse_row_sum w )
  | _ -> Full_vector ( M.full_row_sum w ) ;;

(** 
matrix_column_sum matrix
*)

let matrix_column_sum = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let c = Array.length w.(0) in
    let accu = array_null c
    and cc = pred c in
     for i = 0 to pred ( Array.length w ) do
      let row = w.(i) in
       for j = 0 to cc do
        accu.(j) <- R.add accu.(j) row.(j)
       done ;
     done ;
     Full_vector accu
  end
 | Sparse_matrix w ->
  match w with
  | M.Sparse_tensor_matrix t -> Sparse_vector ( M.sparse_column_sum w )
  | _ -> Full_vector ( M.full_column_sum w ) ;;

(** 
matrix_sum matrix
*)

let matrix_sum = function (m:matrix) ->
 vector_sum ( matrix_row_sum m ) ;;

(** 
matrix_vector_prod matrix vector
*)

let matrix_vector_prod = fun (m:matrix) (v:vector) ->
 match m with
 | Full_matrix w ->
  begin
   let f = function x -> vector_scal_prod v ( Full_vector x ) in
    Full_vector ( Array.map f w )
  end
 | Sparse_matrix w ->
  begin
   match w with
   | M.Sparse_tensor_matrix t ->
    begin
     match v with
     | Sparse_vector x -> Sparse_vector ( M.matrix_sparse_vector_sparse_prod w x )
     | Full_vector x -> Sparse_vector ( M.matrix_full_vector_sparse_prod w x )
    end
   | _ ->
    begin
     match v with
     | Sparse_vector x -> Full_vector ( M.matrix_sparse_vector_full_prod w x )
     | Full_vector x -> Full_vector ( M.matrix_full_vector_full_prod w x )
    end
  end ;;

(** 
vector_matrix_prod vector matrix
*)

let vector_matrix_prod = fun (v:vector) (m:matrix) ->
 let f = fun fake x -> vector_scal_prod v x in
  matrix_row_fold f ( vector_zero () ) m ;;

(** 
matrix_row_max matrix
*)

let matrix_row_max = function (m:matrix) ->
 match m with
 | Full_matrix w -> Full_vector ( Array.map ( Util.array_maximum R.compare ) w )
 | Sparse_matrix w ->
  begin
   match w with
   | M.Sparse_tensor_matrix t -> Sparse_vector ( M.sparse_row_max w )
   | _ -> Full_vector ( M.full_row_max w )
  end ;;

(** 
matrix_row_min matrix
*)

let matrix_row_min = function (m:matrix) ->
 match m with
 | Full_matrix w -> Full_vector ( Array.map ( Util.array_minimum R.compare ) w )
 | Sparse_matrix w ->
  begin
   match w with
   | M.Sparse_tensor_matrix t -> Sparse_vector ( M.sparse_row_min w )
   | _ -> Full_vector ( M.full_row_min w )
  end ;;

(** 
matrix_column_max matrix
*)

let matrix_column_max = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and result = Array.map R.copy w.(0) in
    let c = Array.length result in
     let cc = pred c in
      for i = 0 to pred r do
       let row = w.(i) in
        for j = 0 to cc do
         let test = row.(j) in
          if R.compare test result.(j) > 0 then
           result.(j) <- test
        done ;
      done ;
      Full_vector result
  end
 | Sparse_matrix w ->
  begin
   match w with
   | M.Sparse_tensor_matrix t -> Sparse_vector ( M.sparse_column_max w )
   | _ -> Full_vector ( M.full_column_max w )
  end ;;

(** 
matrix_column_min matrix
*)

let matrix_column_min = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let r = Array.length w
   and result = Array.map R.copy w.(0) in
    let c = Array.length result in
     let cc = pred c in
      for i = 0 to pred r do
       let row = w.(i) in
        for j = 0 to cc do
         let test = row.(j) in
          if R.compare test result.(j) < 0 then
           result.(j) <- test
        done ;
      done ;
      Full_vector result
  end
 | Sparse_matrix w ->
  begin
   match w with
   | M.Sparse_tensor_matrix t -> Sparse_vector ( M.sparse_column_min w )
   | _ -> Full_vector ( M.full_column_min w )
  end ;;

(** 
matrix_max matrix
*)

let matrix_max = function (m:matrix) ->
 match m with
 | Full_matrix w -> Util.array_maximum R.compare ( Array.map ( Util.array_maximum R.compare ) w )
 | Sparse_matrix w ->
  begin
   match w with
   | M.Sparse_tensor_matrix t -> M.sparse_matrix_max w
   | _ -> M.full_matrix_max w
  end ;;

(** 
matrix_min matrix
*)

let matrix_min = function (m:matrix) ->
 match m with
 | Full_matrix w -> Util.array_minimum R.compare ( Array.map ( Util.array_minimum R.compare ) w )
 | Sparse_matrix w ->
  begin
   match w with
   | M.Sparse_tensor_matrix t -> M.sparse_matrix_min w
   | _ -> M.full_matrix_min w
  end ;;

(** 
matrix_norm_1 matrix
*)

let matrix_norm_1 = function (m:matrix) ->
 match m with
 | Full_matrix w -> Array.fold_left R.norm_add ( R.norm_zero () ) ( Array.map ( Util.array_maximum R.norm_compare ) ( Array.map ( Array.map R.norm ) w ) ) 
 | Sparse_matrix w -> M.norm_1 w ;;

(** 
matrix_norm_inf matrix
*)

let matrix_norm_inf = function (m:matrix) ->
 match m with
 | Full_matrix w -> Util.array_maximum R.norm_compare ( Array.map ( Array.fold_left R.norm_add ( R.norm_zero () ) ) ( Array.map ( Array.map R.norm ) w ) )
 | Sparse_matrix w -> M.norm_inf w ;;

(** 
matrix_norm_sum matrix
*)

let matrix_norm_sum = function (m:matrix) ->
 match m with
 | Full_matrix w -> let f = Array.fold_left R.norm_add ( R.norm_zero () ) in f ( Array.map f ( Array.map ( Array.map R.norm ) w ) )
 | Sparse_matrix w -> M.norm_sum w ;;

(** 
matrix_square_norm_frobenius matrix
*)

let matrix_square_norm_frobenius = function (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let g = function x ->
    begin
     let y = R.norm x in
      R.norm_mult y y
    end in
    let f = Array.fold_left R.norm_add ( R.norm_zero () ) in f ( Array.map f ( Array.map ( Array.map g ) w ) )
  end
 | Sparse_matrix w -> M.square_norm_frobenius w ;;

(** 
matrix_trace matrix
*)

let matrix_trace = function (m:matrix) ->
 match m with
 | Full_matrix w -> Array.fold_left R.add ( R.zero () ) ( vector_full_demakeup ( matrix_full_diag_extract m ) )
 | Sparse_matrix w ->
  begin
   match w with
   | M.Sparse_tensor_matrix t -> M.sparse_trace w
   | _ -> M.full_trace w
  end ;;

(** 
matrix_scal_mult scalar matrix
*)

let matrix_scal_mult = fun (x:coeff) (m:matrix) ->
 match m with
 | Full_matrix w ->
  begin
   let f = Array.map ( R.mult x ) in
    Full_matrix ( Array.map f w )
  end
 | Sparse_matrix w -> Sparse_matrix ( M.scal_mult x w ) ;;

(** 
matrix_add matrix1 matrix2
*)

let rec matrix_add = fun (m:matrix) (p:matrix) ->
 if matrix_eq_zero m then
  matrix_copy p
 else
  begin
   if matrix_eq_zero p then
    matrix_copy m
   else
    begin
     match m with
     | Full_matrix mm ->
      begin
       match p with
       | Full_matrix pp ->
        begin
         let r = min ( Array.length mm ) ( Array.length pp )
         and c = min ( Array.length mm.(0) ) ( Array.length pp.(0) ) in
          let q = array_array_null [| r ; c |]
          and cc = pred c in
           for i = 0 to pred r do
            let row_output = q.(i)
            and row_left = mm.(i)
            and row_right = pp.(i) in
             for j = 0 to cc do
              row_output.(j) <- R.add row_left.(j) row_right.(j)
             done ;
           done ;
           Full_matrix q
        end
       | Sparse_matrix pp ->
        begin
         let ppp = matrix_to_full p in
          matrix_add m ppp
        end
      end
     | Sparse_matrix mm ->
      begin
       match p with
       | Full_matrix pp -> matrix_add p m
       | Sparse_matrix pp -> Sparse_matrix ( M.add mm pp )
      end
    end
  end ;;

(** 
matrix_sub matrix1 matrix2
*)

let rec matrix_sub = fun (m:matrix) (p:matrix) ->
 if matrix_eq_zero m then
  matrix_opp p
 else
  begin
   if matrix_eq_zero p then
    matrix_copy m
   else
    begin
     match m with
     | Full_matrix mm ->
      begin
       match p with
       | Full_matrix pp ->
        begin
         let r = min ( Array.length mm ) ( Array.length pp )
         and c = min ( Array.length mm.(0) ) ( Array.length pp.(0) ) in
          let q = array_array_null [| r ; c |]
          and cc = pred c in
           for i = 0 to pred r do
            let row_output = q.(i)
            and row_left = mm.(i)
            and row_right = pp.(i) in
             for j = 0 to cc do
              row_output.(j) <- R.sub row_left.(j) row_right.(j)
             done ;
           done ;
           Full_matrix q
        end
       | Sparse_matrix pp ->
        begin
         let ppp = matrix_to_full p in
          matrix_sub m ppp
        end
      end
     | Sparse_matrix mm ->
      begin
       match p with
       | Full_matrix pp ->
        begin
         let mmm = matrix_to_full m in
          matrix_sub mmm p
        end
       | Sparse_matrix pp -> Sparse_matrix ( M.sub mm pp )
      end
    end
  end ;;

(** 
matrix_eq matrix1 matrix2
*)

let matrix_eq = fun (m:matrix) (p:matrix) ->
 match m with
 | Full_matrix mm ->
  begin
   match p with
   | Full_matrix pp -> Util.array_eq ( Util.array_eq R.eq ) mm pp
   | Sparse_matrix pp ->
    begin
     let ppp = matrix_to_full p in
      matrix_eq m ppp
    end
  end
 | Sparse_matrix mm ->
  begin
   match p with
   | Full_matrix pp -> matrix_eq p m
   | Sparse_matrix pp -> M.eq mm pp
  end ;;

(** 
matrix_twisted_mult matrix1 matrix2
*)

let matrix_twisted_mult = fun (m:matrix) (p:matrix) ->
 match m with
 | Full_matrix mm ->
  begin
   match p with
   | Full_matrix pp ->
    begin
     let r = Array.length mm
     and c = Array.length pp.(0) in
      let q = array_array_null [| r ; c |]
      and cc = pred c in
       for i = 0 to pred r do
        let row_left = Full_vector mm.(i)
        and row_output = q.(i) in
         for j = 0 to cc do
          row_output.(j) <- vector_scal_prod row_left ( Full_vector pp.(j) )
         done ;
       done ;
       Full_matrix q
    end
   | Sparse_matrix pp -> Sparse_matrix ( M.full_sparse_twisted_mult mm pp )
  end
 | Sparse_matrix mm ->
  begin
   match p with
   | Full_matrix pp -> Sparse_matrix ( M.sparse_full_twisted_mult mm pp )
   | Sparse_matrix pp -> Sparse_matrix ( M.twisted_mult mm pp )
  end ;;

(** 
matrix_square_sum matrix
*)

let matrix_square_sum = function (m:matrix) ->
 matrix_trace ( matrix_twisted_mult m m ) ;;

(** 
matrix_mult matrix1 matrix2
*)

let matrix_mult = fun (m:matrix) (p:matrix) ->
 match m with
 | Full_matrix mm ->
  begin
   match p with
   | Full_matrix pp -> matrix_twisted_mult m ( matrix_transpose p )
   | Sparse_matrix pp -> Sparse_matrix ( M.full_sparse_mult mm pp )
  end
 | Sparse_matrix mm ->
  begin
   match p with
   | Full_matrix pp -> Sparse_matrix ( M.sparse_full_mult mm pp )
   | Sparse_matrix pp -> Sparse_matrix ( M.mult mm pp )
  end ;;

(** 
matrix_triple_mult matrix1 matrix2 matrix3
*)

let matrix_triple_mult = fun (m:matrix) (n:matrix) (p:matrix) ->
 match ( m , n , p ) with
 | ( Sparse_matrix mm , Sparse_matrix nn , Sparse_matrix pp ) -> Sparse_matrix ( M.triple_mult mm nn pp )
 | _ ->
  begin
   let pp = matrix_transpose p in
    matrix_twisted_mult m ( matrix_twisted_mult pp n )
  end ;;

(** 
matrix_commut matrix1 matrix2
*)

let matrix_commut = fun (m:matrix) (n:matrix) ->
 matrix_sub ( matrix_mult m n ) ( matrix_mult n m ) ;;


(** 
matrix_of_blocks matrices_matrix
If one of the matrices is full, then so is the result. If all are sparse, then so is the result.

Si l'une des matrices est pleine, alors le résultat l'est. Si toutes sont creuses, alors le résultat l'est. *)


let matrix_of_blocks = function (m:matrix array array) ->
 let small_dims = Array.map ( Array.map matrix_dimensions ) m
 and r = Array.length m
 and c = Array.length m.(0) in
  let brute_widths = Array.map ( Array.map ( function x -> x.(1) ) ) small_dims
  and brute_heights = Array.map ( Array.map ( function x -> x.(0) ) ) small_dims
  and bands = Array.make r m.(0).(0)
  and mm = Array.make_matrix r c m.(0).(0) in
   let heights = Array.map ( Util.array_maximum compare ) brute_heights
   and widths =  Array.map ( Util.array_maximum compare ) ( Util.transpose brute_widths ) in
    let nrows = Array.fold_left ( + ) 0 heights
    and ncolumns = Array.fold_left ( + ) 0 widths
    and v_shifts = Array.append [| 0 |] heights
    and h_shifts = Array.append [| 0 |] widths in
     for i = 0 to pred r do
      v_shifts.( succ i ) <- v_shifts.(i) + heights.(i)
     done ;
     for i = 0 to pred c do
      h_shifts.( succ i ) <- h_shifts.(i) + widths.(i)
     done ;
     let f = fun i z -> matrix_embed [| nrows ; ncolumns |] [| v_shifts.(i) ; 0 |] z
     and g = fun i j z -> matrix_embed [| heights.(i) ; ncolumns |] [| 0 ; h_shifts.(j) |] z in
      for i = 0 to pred r do
       mm.(i) <- Array.mapi ( g i ) m.(i) ;
       bands.(i) <- Array.fold_left matrix_add ( matrix_sparse_null [| heights.(i) ; ncolumns |] ) mm.(i) ;
      done ;
      let mmm = Array.mapi f bands in
       Array.fold_left matrix_add ( matrix_sparse_null [| nrows ; ncolumns |] ) mmm ;;


(** 
matrix_sparse_of_blocks sparser matrices_matrix
The resulting matrix is sparse.

La matrice résultat est creuse. *)


let matrix_sparse_of_blocks = fun sparser (m:matrix array array) ->
 let small_dims = Array.map ( Array.map matrix_dimensions ) m
 and r = Array.length m
 and c = Array.length m.(0) in
  let brute_widths = Array.map ( Array.map ( function x -> x.(1) ) ) small_dims
  and brute_heights = Array.map ( Array.map ( function x -> x.(0) ) ) small_dims
  and bands = Array.make r m.(0).(0)
  and mm = Array.make_matrix r c m.(0).(0) in
   let heights = Array.map ( Util.array_maximum compare ) brute_heights
   and widths =  Array.map ( Util.array_maximum compare ) ( Util.transpose brute_widths ) in
    let nrows = Array.fold_left ( + ) 0 heights
    and ncolumns = Array.fold_left ( + ) 0 widths
    and v_shifts = Array.append [| 0 |] heights
    and h_shifts = Array.append [| 0 |] widths in
     for i = 0 to pred r do
      v_shifts.( succ i ) <- v_shifts.(i) + heights.(i)
     done ;
     for i = 0 to pred c do
      h_shifts.( succ i ) <- h_shifts.(i) + widths.(i)
     done ;
     let f = fun i z -> matrix_embed [| nrows ; ncolumns |] [| v_shifts.(i) ; 0 |] z
     and g = fun i j z -> matrix_embed [| heights.(i) ; ncolumns |] [| 0 ; h_shifts.(j) |] ( sparser z ) in
      for i = 0 to pred r do
       mm.(i) <- Array.mapi ( g i ) m.(i) ;
       bands.(i) <- Array.fold_left matrix_add ( matrix_sparse_null [| heights.(i) ; ncolumns |] ) mm.(i) ;
      done ;
      let mmm = Array.mapi f bands in
       Array.fold_left matrix_add ( matrix_sparse_null [| nrows ; ncolumns |] ) mmm ;;

(** 
sparse_diag_matrix_of_blocks sparser matrices_vector
*)

let sparse_diag_matrix_of_blocks = fun sparser (v:matrix array) ->
 let r = Array.length v in
  let m = Array.make_matrix r r ( matrix_zero () ) in
   for i = 0 to pred r do
    m.(i).(i) <- v.(i) ;
   done ;
   matrix_sparse_of_blocks sparser m ;;

(** 
diag_matrix_of_blocks matrices_vector
*)

let diag_matrix_of_blocks = function (v:matrix array) ->
 let r = Array.length v in
  let m = Array.make_matrix r r ( matrix_zero () ) in
   for i = 0 to pred r do
    m.(i).(i) <- v.(i) ;
   done ;
   matrix_of_blocks m ;;




(**
§ § §
*)





end ;;




module Field (F:Data.Field_coeff_type) = struct




(**
§
*)

(**

Utilitaires

Utilities

 *)

(**
*)




(** The module resulting from the application of the functor Math.Mat.Rng or Graphicmath.Mat.Rng to the module F is included in the present module.

Le module résultant de l'application du foncteur Math.Mat.Rng ou Graphicmath.Mat.Rng au module F est inclus dans le présent module. *)



include ( Rng (F) ) ;;
(**
include ( Rng (F) )
*)




(** The module U realizes the calculation on the sparse vectors with coefficients in the field F and indices of type int.

Le module U réalise le calcul sur les vecteurs creux à coefficients dans le corps commutatif F et à indices de type int.*)


module U = Sparse_vector.Field (Data.Zindex) (Hash.Z) (F) ;;



(** The module S realizes the calculation on the sparse tensors with coefficients in the field F and indices of type int.

Le module S réalise le calcul sur les tenseurs creux à coefficients dans le corps commutatif F et à indices de type int.*)


module S = Sparse_tensor.Field (Data.Zindex) (Hash.Z) (F) ;;



(** The module N realizes the calculation on the sparse matrices with coefficients in the field F and indices of type int.

Le module N réalise le calcul sur les matrices creuses à coefficients dans le corps commutatif F et à indices de type int.*)


module N = Sparse_matrix.Field (Data.Zindex) (Hash.Z) (F) ;;



(** 
scalar_matrix scalar dimensions
*)

let scalar_matrix = fun (x:coeff) (d:int array) ->
 Sparse_matrix ( N.Diff_to_scal_matrix ( x , S.null d ) ) ;;

(** 
identity_matrix dimensions
*)

let identity_matrix = function (d:int array) ->
  scalar_matrix ( F.one () ) d ;;

(** 
coeff_two unit
*)

let coeff_two = function () ->
 N.coeff_two () ;;

(** 
coeff_half unit
*)

let coeff_half = function () ->
 N.coeff_half () ;;




(**
§
*)

(**

Opérations

 *)

(**
*)





(** 
vector_in_place_scal_left_div scalar vector
*)

let vector_in_place_scal_left_div = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Array.iteri ( fun i x -> w.(i) <- F.div x y ) w
 | Sparse_vector w -> U.in_place_scal_left_div y w ;;

(** 
vector_scal_left_div scalar vector
*)

let vector_scal_left_div = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Full_vector ( Array.map ( function x -> F.div x y ) w )
 | Sparse_vector w -> Sparse_vector ( U.scal_left_div y w ) ;;

(** 
vector_in_place_scal_right_div scalar vector
*)

let vector_in_place_scal_right_div = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Array.iteri ( fun i x -> w.(i) <- F.div y x ) w
 | Sparse_vector w -> U.in_place_scal_right_div y w ;;

(** 
vector_scal_right_div scalar vector
*)

let vector_scal_right_div = fun (y:coeff) (v:vector) ->
 match v with
 | Full_vector w -> Full_vector ( Array.map ( F.div y ) w )
 | Sparse_vector w -> Sparse_vector ( U.scal_right_div y w ) ;;

(** 
vector_reciprocal vector
*)

let vector_reciprocal = function (v:vector) ->
 match v with
 | Full_vector w -> vector_scal_left_div ( F.norm_inject ( vector_square_norm_2 v ) ) v
 | Sparse_vector w -> Sparse_vector ( U.reciprocal w ) ;;

(** 
tensor_in_place_scal_left_div scalar tensor
*)

let tensor_in_place_scal_left_div = fun (x:coeff) (v:tensor) ->
 match v with
 | Full_tensor w -> tensor_in_place_scal_mult ( F.inv x ) v
 | Vector w -> vector_in_place_scal_left_div x w
 | Sparse_tensor w -> S.in_place_scal_left_div x w ;;

(** 
tensor_scal_left_div scalar tensor
*)

let tensor_scal_left_div = fun (x:coeff) (v:tensor) ->
 match v with
 | Full_tensor w -> tensor_scal_mult ( F.inv x ) v
 | Vector w -> Vector ( vector_scal_left_div x w )
 | Sparse_tensor w -> Sparse_tensor ( S.scal_left_div x w ) ;;

(** 
matrix_scal_left_div scalar matrix
*)

let matrix_scal_left_div = fun (x:coeff) (v:matrix) ->
 match v with
 | Full_matrix w -> matrix_scal_mult ( F.inv x ) v
 | Sparse_matrix w -> Sparse_matrix ( N.scal_left_div x w ) ;;

(** 
matrix_scal_reciprocal matrix
*)

let matrix_scal_reciprocal = function (m:matrix) ->
 match m with
 | Full_matrix w -> matrix_scal_left_div ( F.norm_inject ( matrix_square_norm_frobenius m ) ) m
 | Sparse_matrix w -> Sparse_matrix ( N.reciprocal w ) ;;

(** 
matrix_sym matrix
*)

let matrix_sym = function (m:matrix) ->
 let mm = matrix_transpose m in
  matrix_scal_mult ( coeff_half () ) ( matrix_add m mm )

(** 
matrix_antisym matrix
*)

let matrix_antisym = function (m:matrix) ->
 let mm = matrix_transpose m in
  matrix_scal_mult ( coeff_half () ) ( matrix_sub m mm )

(** 
in_place_pivot_downward matrix1 matrix2
*)

let in_place_pivot_downward = fun (m:matrix) (p:matrix) ->
 match ( m , p ) with
 | ( Sparse_matrix mm , Sparse_matrix pp ) -> N.in_place_pivot_downward mm pp
 | ( Full_matrix w , _ ) ->
  begin
   let index = ref 0
   and r = Array.length w
   and factor = ref ( F.one () )
   and coeff = ref ( F.one () )
   and row_left = ref ( vector_zero () )
   and row_right = ref ( vector_zero () )
   and row_output_left = ref ( vector_zero () )
   and row_output_right = ref ( vector_zero () )
   and first_column = ref ( vector_zero () ) in
    let rr = pred r in
     for i = 0 to rr do
      first_column := mask_vector i rr ( matrix_column_extract i m ) ;
      index := vector_first_non_zero !first_column ;
      if !index < 0 then
       failwith "Non invertible left matrix in Mat.Field.in_place_pivot_downward." ;
      if !index > i then
       begin
        vector_exchange i !index !first_column ;
        matrix_row_exchange i !index m ;
        matrix_row_exchange i !index p ;
       end ;
      factor := F.inv ( vector_extract i !first_column ) ;
      row_left := matrix_row_extract i m ;
      vector_in_place_scal_mult !factor !row_left ;
      vector_replace ( F.one () ) i !row_left ;
      matrix_row_replace !row_left i m ;
      row_right := matrix_row_extract i p ;
      vector_in_place_scal_mult !factor !row_right ;
      matrix_row_replace !row_right i p ;
      for j = succ i to rr do
       row_output_left := matrix_row_extract j m ;
       coeff := vector_extract i !row_output_left ;
       row_output_left := vector_sub !row_output_left ( vector_scal_mult !coeff !row_left ) ;
       vector_replace ( F.zero () ) i !row_output_left ;
       matrix_row_replace !row_output_left j m ;
       row_output_right := matrix_row_extract j p ;
       row_output_right := vector_sub !row_output_right ( vector_scal_mult !coeff !row_right ) ;
       matrix_row_replace !row_output_right j p ;
      done ;
     done ;
  end
 | _ -> failwith "Incompatible formats in Mat.Field.in_place_pivot_downward." ;;

(** 
pivot_downward matrix1 matrix2
*)

let rec pivot_downward = fun (m:matrix) (p:matrix) ->
 match ( m , p ) with
 | ( Sparse_matrix mm , Sparse_matrix pp ) ->
  begin
   let result = N.pivot_downward mm pp in
    [| Sparse_matrix result.(0) ; Sparse_matrix result.(1) |]
  end
 | ( Full_matrix w , _ ) ->
  begin
   let mm = matrix_copy m
   and pp = matrix_copy p in
    in_place_pivot_downward mm pp ;
    [| mm ; pp |]
  end
 | ( Sparse_matrix mm , Full_matrix pp ) ->
  begin
   let mmm = matrix_to_full m
   and ppp = matrix_copy p in
    in_place_pivot_downward mmm ppp ;
    [| mmm ; ppp |]
  end ;;

(** 
invertibility matrix
*)

let invertibility = function (m:matrix) ->
 match m with
 | Sparse_matrix mm -> N.invertibility mm
 | Full_matrix ww ->
  begin
   let index = ref 0
   and r = Array.length ww
   and factor = ref ( F.one () )
   and coeff = ref ( F.one () )
   and row = ref ( vector_zero () )
   and row_output = ref ( vector_zero () )
   and first_column = ref ( vector_zero () ) in
    let rr = pred r
    and p = matrix_copy m in
     try
      begin
       for i = 0 to pred rr do
        first_column := mask_vector i rr ( matrix_column_extract i p ) ;
        index := vector_first_non_zero !first_column ;
        if !index < 0 then
         failwith "Non invertibility condition in Mat.Field.invertibility." ;
        if !index > i then
         begin
          vector_exchange i !index !first_column ;
          matrix_row_exchange i !index p ;
         end ;
        factor := F.inv ( vector_extract i !first_column ) ;
        row := matrix_row_extract i p ;
        vector_in_place_scal_mult !factor !row ;
        vector_replace ( F.one () ) i !row ;
        matrix_row_replace !row i p ;
        for j = succ i to rr do
         row_output := matrix_row_extract j p ;
         coeff := vector_extract i !row_output ;
         row_output := vector_sub !row_output ( vector_scal_mult !coeff !row ) ;
         matrix_row_replace !row_output j p ;
        done ;
       done ;
       not ( F.eq_zero ( matrix_extract rr rr p ) )
      end
     with _ ->
      false
  end ;;

(** 
det matrix
*)

let det = function (m:matrix) ->
 match m with
 | Sparse_matrix mm -> N.det mm
 | Full_matrix ww ->
  begin
   let index = ref 0
   and result = ref ( F.one () )
   and r = Array.length ww
   and factor = ref ( F.one () )
   and coeff = ref ( F.one () )
   and row = ref ( vector_zero () )
   and row_output = ref ( vector_zero () )
   and first_column = ref ( vector_zero () ) in
    let rr = pred r
    and p = matrix_copy m in
     try
      begin
       for i = 0 to pred rr do
        first_column := mask_vector i rr ( matrix_column_extract i p ) ;
        index := vector_first_non_zero !first_column ;
        if !index < 0 then
         failwith "Non invertibility condition in Mat.Field.det." ;
        if !index > i then
         begin
          vector_exchange i !index !first_column ;
          matrix_row_exchange i !index p ;
         end ;
        factor := vector_extract i !first_column ;
        result := F.mult !result !factor ;
        factor := F.inv !factor ;
        row := matrix_row_extract i p ;
        vector_in_place_scal_mult !factor !row ;
        vector_replace ( F.one () ) i !row ;
        matrix_row_replace !row i p ;
        for j = succ i to rr do
         row_output := matrix_row_extract j p ;
         coeff := vector_extract i !row_output ;
         row_output := vector_sub !row_output ( vector_scal_mult !coeff !row ) ;
         matrix_row_replace !row_output j p ;
        done ;
       done ;
       F.mult !result ( matrix_extract rr rr p )
      end
     with _ ->
      F.zero ()
  end ;;


(** 
in_place_pivot_upward matrix1 matrix2
The left matrix m is supposed to be upper triangular with ones on the diagonal.

La matrice de gauche m est supposée triangulaire supérieure avec des 1 sur la diagonale. *)


let in_place_pivot_upward = fun (m:matrix) (p:matrix) ->
 match ( m , p ) with
 | ( Sparse_matrix mm , Sparse_matrix pp ) -> N.in_place_pivot_upward mm pp
 | ( Full_matrix w , _ ) ->
  begin
   let index = ref 0
   and r = Array.length w
   and coeff = ref ( F.one () )
   and row_right = ref ( vector_zero () )
   and row_output_left = ref ( vector_zero () )
   and row_output_right = ref ( vector_zero () )
   and last_column = ref ( vector_zero () ) in
    let rr = pred r in
     for i = rr downto 1 do
      index := pred i ;
      last_column := mask_vector 0 !index ( matrix_column_extract i m ) ;
      row_right := matrix_row_extract i p ;
      for j = !index downto 0 do
       row_output_left := matrix_row_extract j m ;
       coeff := vector_extract i !row_output_left ;
       matrix_replace ( F.zero () ) j i m ;
       row_output_right := matrix_row_extract j p ;
       row_output_right := vector_sub !row_output_right ( vector_scal_mult !coeff !row_right ) ;
       matrix_row_replace !row_output_right j p ;
      done ;
     done ;
  end
 | _ -> failwith "Incompatible formats in Mat.Field.in_place_pivot_upward." ;;

(** 
pivot_upward matrix1 matrix2
*)

let rec pivot_upward = fun (m:matrix) (p:matrix) ->
 match ( m , p ) with
 | ( Sparse_matrix mm , Sparse_matrix pp ) ->
  begin
   let result = N.pivot_upward mm pp in
    [| Sparse_matrix result.(0) ; Sparse_matrix result.(1) |]
  end
 | ( Full_matrix w , _ ) ->
  begin
   let mm = matrix_copy m
   and pp = matrix_copy p in
    in_place_pivot_upward mm pp ;
    [| mm ; pp |]
  end
 | ( Sparse_matrix mm , Full_matrix pp ) ->
  begin
   let mmm = matrix_to_full m
   and ppp = matrix_copy p in
    in_place_pivot_upward mmm ppp ;
    [| mmm ; ppp |]
  end ;;

(** 
inv matrix
*)

let inv = function (m:matrix) ->
 let d = matrix_dimensions m
 and mm = matrix_copy m in
  let p = identity_matrix d in
   in_place_pivot_downward mm p ;
   in_place_pivot_upward mm p ;
   p ;;

(** 
left_quotient matrix1 matrix2
*)

let left_quotient = fun (m:matrix) (p:matrix) ->
 let mm = matrix_copy m
 and pp = matrix_copy p in
  in_place_pivot_downward mm pp ;
  in_place_pivot_upward mm pp ;
  pp ;;

(** 
right_quotient matrix1 matrix2
*)

let right_quotient = fun (m:matrix) (p:matrix) ->
 let mm = matrix_transpose m
 and pp = matrix_transpose p in
  matrix_transpose ( left_quotient pp mm ) ;;

(** 
cond matrix_norm invertor matrix
*)

let cond = fun (norm:matrix -> F.u) (invertor:matrix -> matrix) (m:matrix) ->
 F.norm_mult ( norm m ) ( norm ( invertor m ) ) ;;

(** 
naive_solve matrix vector
*)

let naive_solve = fun (m:matrix) (v:vector) ->
 matrix_vector_prod ( inv m ) v ;;

(** 
solve matrix vector
*)

let solve = fun (m:matrix) (v:vector) ->
 let p = match v with
 | Full_vector x -> Full_matrix ( Array.map ( Array.make 1 ) x )
 | Sparse_vector x -> Sparse_matrix ( N.transpose ( N.sparse_vector_to_square_matrix x ) ) in
  let q = left_quotient m p in
   match p with
   | Full_matrix y -> Full_vector ( Array.map ( function z -> z.(0) ) ( matrix_full_demakeup q ) )
   | Sparse_matrix y -> Sparse_vector ( N.column_extract 0 ( matrix_sparse_demakeup q ) ) ;;

(** 
tune_inv matrix inverse_candidate
*)

let tune_inv = fun (x:matrix) (y:matrix) ->
 let d = matrix_dimensions x in
  let double = scalar_matrix ( coeff_two () ) ( Array.make 2 d.(0) )
  and right_product = matrix_mult x y in
   let difference = matrix_sub double right_product in
    matrix_mult y difference ;;

(** 
approx_inv matrix_norm invertor matrix
*)

let approx_inv = fun (norm:matrix -> F.u) (invertor:matrix -> matrix) (x:matrix) ->
 let y = invertor x
 and d = matrix_dimensions x in
  let product = matrix_mult x y
  and id = identity_matrix ( Array.make 2 d.(0) )
  and result = tune_inv x y in
   let error0 = norm ( matrix_sub product id )
   and new_product = matrix_mult x result in
    let error1 = norm ( matrix_sub new_product id ) in
     if F.norm_compare error1 error0 >= 0 then
      ( y , error0 )
     else
      ( result , error1 ) ;;

(** 
matrix_extrap_inv parameter matrix
*)

let matrix_extrap_inv = fun (parameter:F.t) (x:matrix) ->
 let y = inv x in
  let yy = tune_inv x y in
   matrix_add yy ( matrix_scal_mult parameter ( matrix_sub yy y ) ) ;;

(** 
approx_solve matrix_norm matrix vector
*)

let approx_solve = fun (norm:matrix -> F.u) (m:matrix) (v:vector) ->
 let mm = fst ( approx_inv norm inv m ) in
  matrix_vector_prod mm v ;;

(** 
matrix_iterate exponent matrix vector
*)

let matrix_iterate = fun (s:int) (x:matrix) (v:vector) ->
 let y = ref v in
  if s >= 0 then
   begin
    for i = 1 to s do
     y := matrix_vector_prod x !y
    done
   end
  else
   begin
    let xx = fst ( approx_inv matrix_norm_inf inv x ) in
     for i = 1 to s do
      y := matrix_vector_prod xx !y
     done
   end ;
   !y

(** 
matrix_power exponent matrix
*)

let rec matrix_power = fun (s:int) (x:matrix) ->
 if s >= 0 then
  begin
   if s = 0 then identity_matrix ( matrix_dimensions x )
   else
    let n = s / 2 in
     let factor = matrix_power n x in
      let prod = matrix_mult factor factor in
       if s mod 2 = 0 then prod
       else matrix_mult prod x
  end
 else
  begin
   let xx = fst ( approx_inv matrix_norm_inf inv x ) in
    matrix_power ( abs s ) xx
  end ;;









(**
§ § §
*)





end ;;










(**
§ § §
*)






end ;;







module Matrix = struct




(**
§
*)

(**

Introduction

 *)

(**
*)





(** The mathematician will find in this module:

  • constructions to practice matrix calculus with integer and real coefficients,
  • common convergence acceleration methods,
  • methods of block matrix calculus through variant types float_or_array and int_or_array.

Conventions

Vectors are rows of scalars (float or int), of type float array or int array.

A (bidimensional) matrix is a row vector, each element of which being a row of the matrix. Matrices are of type float array array or int array array.

Comments

The delivered functions are rough from workshop and require the usual care of use.

The iterative refinement of the inverse of a matrix may be stopped by testing the difference between the product and the identity or by detecting a too weak variation of the candidate, as suggested by William Kahan in :

http://www.cs.berkeley.edu/~wkahan/Cantilever.pdf

This author confesses to be the author of the HP15C calulator's high level mathematical functions manual in the page 5 of :

http://www.cs.berkeley.edu/~wkahan/MktgMath.pdf

This manual is a good introduction to error analysis.

The block calculus allows to replace blocks of matrices by scalars (float or int). Such a simplification implies necessary ambiguities: in a multiplication, the block reduced to a scalar behaves like a scalar matrix; in an addition, it behaves like a saturated matrix. Only the scalar 0 behaves without ambiguity.

The matrices may be cut in blocks in a recursive way; the obtained thickness is not limited: a square matrix of order 2 ^ n cut in a recursive way in two parts (vertically and horizontally) would climb up to the thickness n - 1.

Increment the thickness slows down the elementary calculi on matrices.

A matrix can be invertible by block only if it is generic enough (random enough). In this case, the calculus of the inverse with a block cutting up to the first level may be quicker than usual inverse, for an order greater than about 1250; the rows and columns are cut in 20 to 22 pieces between 1250 and 10000. The increase in speed is due to the replacement of many blocks by the real 0, which compensates the slow of block matrix operations.

On the laptop described below, the inversion of a big random matrix is about five times slower than under scilab compilated with atlas, about twenty percent slower than under scilab compilated without atlas.

This module is distributed under the same licence as Ocaml.

§

La mathématicienne ou le mathématicien trouvera dans ce module :

  • des constructions permettant de pratiquer le calcul matriciel à coefficients entiers et réels,
  • des méthodes usuelles d'accélération de convergence,
  • des méthodes de calcul matriciel par blocs, à l'aide de types variants float_or_array et int_or_array.

Conventions

Les vecteurs sont des lignes de scalaires (float ou int), de type float array ou int array.

Une matrice (bidimensionnelle) est un vecteur ligne dont chaque élément est une ligne de la matrice. Les matrices sont de type float array array ou int array array.

Commentaires

Les fonctions délivrées sont brutes de fonderie et réclament les précautions habituelles d'utilisation.

Le raffinement itératif de l'inverse d'une matrice peut être arrêté par test de l'écart entre le produit et l'identité ou par variation du candidat trop faible, comme proposé par William Kahan dans :

http://www.cs.berkeley.edu/~wkahan/Cantilever.pdf

Cet auteur avoue être l'auteur du manuel des fonctions mathématiques de haut niveau de la calculette HP15C à la page 5 de :

http://www.cs.berkeley.edu/~wkahan/MktgMath.pdf

Ce manuel est une bonne introduction à l'analyse d'erreur.

Le calcul par blocs autorise de remplacer des blocs de matrices par des scalaires (float ou int). Une telle simplification entraîne d'obligatoires ambiguïtés : dans une multiplication, le bloc réduit à un scalaire se comporte comme une matrice scalaire ; dans une addition, il se comporte comme une matrice saturée. Seul le scalaire 0 se comporte sans ambiguïté.

Les matrices peuvent être découpées en blocs de manière récursive ; l'épaisseur obtenue n'est pas limitée : une matrice carrée d'ordre 2 ^ n découpée récursivement en deux (verticalement et horizontalement) monterait jusqu'à l'épaisseur n - 1.

Incrémenter l'épaisseur ralentit les calculs élémentaires sur les matrices.

Une matrice ne peut être bloc-inversible que si elle est suffisamment générique (assez aléatoire). Dans ce cas, le calcul de l'inverse avec un découpage par blocs au premier niveau peut être plus rapide que l'inverse ordinaire, pour un ordre supérieur à 1250 environ ; les lignes et colonnes sont découpées en 20 à 22 morceaux entre 1250 et 10000. L'augmentation de vitesse est due au remplacement de beaucoup de blocs par le réel 0, ce qui compense la lenteur des opérations sur les matrices par blocs.

Sur la machine portable : 

CPU: AMD Athlon(tm) II Dual-Core M300 (1994.94-MHz K8-class CPU)

  Origin = "AuthenticAMD"  Id = 0x100f62  Stepping = 2

  Features=0x178bfbff<FPU,VME,DE,PSE,TSC,MSR,PAE,MCE,CX8,APIC,SEP,MTRR,PGE,MCA,CMOV,PAT,PSE36,CLFLUSH,MMX,FXSR,SSE,SSE2,HTT>

  Features2=0x802009<SSE3,MON,CX16,POPCNT>

  AMD Features=0xee500800<SYSCALL,NX,MMX+,FFXSR,Page1GB,RDTSCP,LM,3DNow!+,3DNow!>

  AMD Features2=0x377f<LAHF,CMP,SVM,ExtAPIC,CR8,ABM,SSE4A,Prefetch,OSVW,IBS,SKINIT,WDT>

  TSC: P-state invariant

real memory  = 4294967296 (4096 MB)

avail memory = 4111618048 (3921 MB)

ACPI APIC Table: <HP     3652    >

FreeBSD/SMP: Multiprocessor System Detected: 2 CPUs

FreeBSD/SMP: 1 package(s) x 2 core(s)

 cpu0 (BSP): APIC ID:  0

 cpu1 (AP): APIC ID:  1






l'inversion d'une grande matrice aléatoire est environ cinq fois plus lente que sous scilab compilé 
avec atlas, environ vingt pour cent plus lente que sous scilab compilé sans atlas.



Ce module est distribué selon la même licence qu'Ocaml.




Copyright Stéphane Grognet 


Laboratoire de mathématiques Jean Leray UMR 6629 CNRS 


Fédération de recherche mathématique des Pays de la Loire 


IREM des Pays de la Loire - Université de Nantes 


version 0.5

*)



(**
@version 0.5
*)



(**
@author Stéphane Grognet
*)



(**
@since 2011, 2012, 2013
*)











(** 
§ 
 *)



(** 

Constructions minimales


Minimal constructions

*)



(** 
 
 *)










open Util ;;










(** 
§ 
 *)



(** 

Constructions polymorphes


Polymorphic constructions

*)



(** 
 
 *)











(** Polymorphic functions are reputed to be slow.



Les fonctions polymorphes sont réputés lentes.*)



(** 
§ 
 *)







(** 
matrix_eq equality matrix1 matrix2
 *)


let matrix_eq = fun eq m n ->

 let p = Array.mapi ( fun i x -> Util.array_eq eq m.(i) x ) n in

  Array.fold_left ( && ) true p ;;




(** 
insert matrix row column element
 *)


let insert = fun m i j x ->

 (m.(i).(j) <- x) ;;




(** 
numrows matrix
 *)


let numrows = function m ->

 Array.length m ;;




(** 
numcolumns matrix
 *)


let numcolumns = function m ->

 if Array.length m = 0 then 0 else Array.length m.(0) ;;




(** 
slow_numcolumns matrix
 slow_numcolumns gives the number of columns even for lacunar matrices:



slow_numcolumns donne le nombre des colonnes même pour les matrices lacunaires. *)


let slow_numcolumns = function m ->

 let long = numrows m in

  if long = 0 then 0 else 

   let accu = ref 0 in

    for i = 0 to long - 1 do

     accu := Util.int_max !accu ( Array.length m.(i) )

    done ;

    !accu ;;






(** 
matrix_max_by_row matrix
 *)


let matrix_max_by_row = function m ->

 Array.map Util.vector_max m ;;




(** 
matrix_max_by_column matrix
 *)


let matrix_max_by_column = function m ->

 matrix_max_by_row ( Util.transpose m ) ;;




(** 
matrix_max matrix
 *)


let matrix_max = function m ->

 Util.vector_max (Array.map Util.vector_max m) ;;




(** 
matrix_min_by_row matrix
 *)


let matrix_min_by_row = function m ->

 Array.map Util.vector_min m ;;




(** 
matrix_min_by_column matrix
 *)


let matrix_min_by_column = function m ->

 matrix_min_by_row ( Util.transpose m ) ;;




(** 
matrix_min matrix
 *)


let matrix_min = function m ->

 Util.vector_min (Array.map Util.vector_min m) ;;




(** 
vector_copy copy_function vector
 *)


let vector_copy = fun copy v ->

 if Array.length v = 0 then [| |]

 else

  begin

   let r = Array.length v in

    let vv = Array.make r v.(0) in

     for i = 0 to r - 1 do

      vv.(i) <- copy v.(i)

     done ;

     vv

  end ;;




(** 
matrix_copy copy_function matrix
 *)


let matrix_copy = fun copy m ->

 let r = numrows m and c = numcolumns m in

  if ( r <= 0 ) or ( c <= 0 ) then [| [| |] |]

  else

   begin

    let mm = Array.make_matrix r c m.(0).(0) in

     for i = 0 to r - 1 do

      mm.(i) <- vector_copy copy m.(i)

     done ;

     mm

   end ;;






(** 
matrix_find_last equality matrix
 matrix_find_last returns [|-1;-1|] if it does not find:



matrix_find_last retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_find_last = fun eq x m ->

 let r = numrows m and index = ref (-1) and indice = ref (-1) in

  let i = ref (r - 1) in

   while !i >= 0 do

    indice := Util.vector_find_last eq x m.(!i) ;

    if !indice <> -1 then (index := !i ; i := -1) else i := !i - 1 ;

   done ;

   [| !index ; !indice |] ;;






(** 
matrix_find_last_first equality matrix
 matrix_find_last returns [|-1;-1|] if it does not find:



matrix_find_last_first retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_find_last_first = fun eq x m ->

 let r = numrows m and index = ref (-1) and indice = ref (-1) in

  let i = ref (r - 1) in

   while !i >= 0 do

    indice := Util.vector_find_first eq x m.(!i) ;

    if !indice <> -1 then (index := !i ; i := -1) else i := !i - 1 ;

   done ;

   [| !index ; !indice |] ;;






(** 
matrix_find_first equality matrix
 matrix_find_first returns [|-1;-1|] if it does not find:



matrix_find_first retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_find_first = fun eq x m ->

 let r = numrows m and index = ref (-1) and indice = ref (-1) and i = ref 0 in

  while  !i < r do

   indice := Util.vector_find_first eq x m.(!i) ;

   if !indice <> -1 then (index := !i ; i := r) else i := !i + 1 ; 

  done ;

  [| !index ; !indice |] ;;






(** 
matrix_find_first_last equality matrix
 matrix_find_first returns [|-1;-1|] if it does not find:



matrix_find_first_last retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_find_first_last = fun eq x m ->

 let r = numrows m and index = ref (-1) and indice = ref (-1) and i = ref 0 in

  while  !i < r do

   indice := Util.vector_find_last eq x m.(!i) ;

   if !indice <> -1 then (index := !i ; i := r) else i := !i + 1 ; 

  done ;

  [| !index ; !indice |] ;;






(** 
matrix_find_twin equality matrix
 matrix_find_first returns [|-1;-1|] if it does not find:



matrix_find_twin retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_find_twin = fun eq x m ->

 let r = numrows m and index = ref (-1) and indice = ref (-1) and i = ref 0 in

  while  !i <= min (r - 1) ( int_of_float ( ceil ( (float r) /. 2. ) ) ) do

   indice := Util.vector_find_twin eq x m.(!i) ;

   if !indice <> -1 then (index := !i ; i := 1 + r) else

    begin

     let j = r - 1 - !i in

      indice := Util.vector_find_twin eq x m.(j) ;

      if !indice <> -1 then (index := j ; i := 1 + r) else i := !i + 1 ; 

    end

  done ;

  [| !index ; !indice |] ;;






(** 
matrix_find_all equality matrix
 matrix_find_all returns [||] if it does not find:



matrix_find_all retourne [||] s'il ne trouve pas.*)


let matrix_find_all = fun eq x m ->

 let r = numrows m and result = ref [||] and index = ref [||] and indice = ref [||] in

  for i = 0 to r - 1 do

   indice := Util.vector_find_all eq x m.(i) ;

   if !indice <> [||] then 

    begin

     index := Array.map (function a -> [| i ; a|]) !indice ; 

     result := Array.append !result !index 

    end

  done ;

  !result ;;




(** 
extract_column column matrix
 *)


let extract_column = fun (i:int) m ->

 let mm = ref[||] in

  mm := Array.append !mm (Array.map (function a -> List.nth (Array.to_list a) i) m) ;

 !mm ;;




(** 
float_extract_column column matrix
 *)


let float_extract_column = fun (j:int) (m:float array array) ->

 let n = Array.length m in

  let v = Array.make n 0. in

   for i = 0 to n - 1 do

    v.(i) <- m.(i).(j) ;

   done ;

   v ;;






(** 
affect_column column_index vector matrix
 The size of the vector may be bigger than the number of rows of the matrix. The modification takes place on the input matrix.



La taille du vecteur peut dépassr le nombre de lignes de la matrice.
La modification a lieu sur la matrice entrée. *)


let affect_column = fun (j:int) v m ->

 let r = numrows m in

  for i = 0 to r - 1 do

   m.(i).(j) <- List.nth (Array.to_list v) i

  done ;;






(** 
float_affect_column column_index vector matrix
 The size of the vector may be bigger than the number of rows of the matrix. The modification takes place on the input matrix.



La taille du vecteur peut dépassr le nombre de lignes de la matrice. La modification a lieu sur la matrice entrée. *)


let float_affect_column = fun (j:int) (v:float array) (m:float array array) ->

 let r = numrows m in

  for i = 0 to r - 1 do

   m.(i).(j) <- v.(i)

  done ;;




(** 
extract_diag matrix
 *)


let extract_diag = function m ->

 let mm = ref[||] 

 and r = min (numrows m) (numcolumns m) in

  for i = 0 to r - 1 do

   mm := Array.append !mm [|m.(i).(i)|]

  done ;

 !mm ;;






(** 
exchange_row index1 index2 matrix
 This function is not sealed.



Cette fonction n'est pas étanche. *)


let exchange_row = fun i j m ->

 let aux = m.(i) in

  m.(i) <- m.(j) ;

  m.(j) <- aux ;

 m ;;




(** 
exchange_column index1 index2 matrix
 This function is not sealed.



Cette fonction n'est pas étanche. *)


let exchange_column = fun i j m ->

 let aux = extract_column i m

 and auxil = extract_column j m in

  affect_column j aux m ;

  affect_column i auxil m ;

  m ;;






(** 
sub_matrix matrix beg-row end-row beg-col end-col
 *)


let sub_matrix = fun m i ii j jj ->


(** i et j : beginning: début ; ii et jj : end: fin *)


 let mm = Array.make_matrix (ii - i + 1) (jj - j + 1) m.(0).(0) in

  for row = i to ii do

   mm.(row-i) <- Array.sub m.(row) j (jj - j + 1) 

  done ;

 mm ;;






(** The functions inline and slice are reciprocal of one another.



Les fonctions inline et slice sont réciproques l'une de l'autre. *)





(** 
inline matrix
 *)


let inline = function m ->

 let r = Array.length m

 and x = m.(0) in

  let c = Array.length x in

   let v = Array.make ( r * c ) x.(0)

   and cc = pred c in

    for i = 0 to pred r do

     let ir = i * r

     and row = m.(i) in

      for j = 0 to cc do

       v.( ir + j ) <- row.(j)

      done 

    done ;

    v ;;




(** 
slice vector
 *)


let slice = fun (n:int) v ->

 let l = Array.length v in

  if l mod n != 0 then failwith "The number of lines must divide the length of the vector in Matrix.slice." ;

   let c = l / n in

    let m = Array.make_matrix n c v.(0)

    and cc =pred c in

     for i = 0 to pred n do

      let row = m.(i)

      and ni = n * i in

       for j = 0 to cc do

        row.(j) <- v.( ni + j )

       done

     done ;

     m ;;












(** 
§ 
 *)



(**

Constructions

*)



(** 
 
 *)











(** The variants bis and ter introduce different behaviours for non square matrices.



Les variantes bis et ter introduisent des comportements différents pour les matrices non carrées. *)





(** 
§ 
 *)







(** 
zeros_float matrix
 *)


let zeros_float = function (m:float array array) ->

 let r = numrows m and c = numcolumns m in

 Array.make_matrix r c 0. ;;




(** 
null_float numrows numcolumns
 *)


let null_float = fun (r:int) (c:int) ->

 Array.make_matrix r c 0. ;;




(** 
ones_float matrix
 *)


let ones_float = function (m:float array array) ->

 let r = numrows m and c = numcolumns m in

 Array.make_matrix r c 1. ;;




(** 
units_float matrix
 *)


let units_float = fun (r:int) (c:int) ->

 Array.make_matrix r c 1. ;;




(** 
fill_float matrix
 *)


let fill_float = fun (m:float array array) (x:float) ->

 Array.make_matrix (Array.length m) (Array.length m.(0)) x ;;




(** 
saturate_float numrows numcolumns real
 *)


let saturate_float = fun (r:int) (c:int) (x:float) ->

 Array.make_matrix r c x ;;






(** 
identity_float numrows numcolumns
 *)


let identity_float = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0. in

  for i = 0 to ( min r c ) - 1 do

   m.(i).(i) <- 1.

  done ;

  m ;;




(** 
identity_float_bis numrows numcolumns
 *)


let identity_float_bis = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0.

 and delta = Util.int_max 0 (c - r) in

  for i = 0 to ( min r c ) - 1 do

   m.(i).( i + delta ) <- 1.

  done ;

  m ;;




(** 
identity_float_ter numrows numcolumns
 *)


let identity_float_ter = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0.

 and delta = Util.int_max 0 (r - c) in

  for i = 0 to ( min r c ) - 1 do

   m.( i + delta ).(i) <- 1.

  done ;

  m ;;






(** 
rank_float_matrix numrows numcolumns rank
 *)


let rank_float_matrix = fun (r:int) (c:int) (rank:int) ->

 let m = Array.make_matrix r c 0. in

  for i = 0 to rank - 1 do

   m.(i).(i) <- 1.

  done ;

  m ;;






(** 
eye_float matrix
 *)


let eye_float = function (m:float array array) ->

 identity_float (Array.length m) (Array.length m.(0)) ;;




(** 
eye_float_bis matrix
 *)


let eye_float_bis = function (m:float array array) ->

 identity_float_bis (Array.length m) (Array.length m.(0)) ;;




(** 
eye_float_ter matrix
 *)


let eye_float_ter = function (m:float array array) ->

 identity_float_ter (Array.length m) (Array.length m.(0)) ;;






(** 
scal_float numrows numcolumns real
 *)


let scal_float = fun (r:int) (c:int) (x:float) ->

  let m = Array.make_matrix r c 0. in

   for i = 0 to ( min r c ) - 1 do

    m.(i).(i) <- x

   done ;

 m ;;




(** 
scal_float_bis numrows numcolumns real
 *)


let scal_float_bis = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0.

 and delta = Util.int_max 0 (c - r) in

  for i = 0 to ( min r c ) - 1 do

   m.(i).( i + delta ) <- x

  done ;

  m ;;




(** 
scal_float_ter numrows numcolumns real
 *)


let scal_float_ter = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0.

 and delta = Util.int_max 0 (r - c) in

  for i = 0 to ( min r c ) - 1 do

   m.( i + delta ).(i) <- x

  done ;

  m ;;






(** 
diag_float vector
 *)


let diag_float = function (v:float array) ->

 let r = Array.length v in

  let m = Array.make_matrix r r 0. in

   for i = 0 to r - 1 do

    m.(i).(i) <- v.(i)

   done ;

 m ;;




(** 
diag_inv_float vector
 *)


let diag_inv_float = function (v:float array) ->

 let r = Array.length v in

  let m = Array.make_matrix r r 0. in

   for i = 0 to r - 1 do

    begin

     let x = v.(i) in

      if x == 0. then failwith "Division by zero in Matrix.diag_inv_float." ;

      m.(i).(i) <- 1. /. x

    end

   done ;

 m ;;




(** 
matrix_float_permu size index1 index2
 *)


let matrix_float_permu = fun n i j ->

 let m = identity_float n n in

   m.(i).(i) <- 0. ;

   m.(j).(j) <- 0. ;

   m.(i).(j) <- 1. ;

   m.(j).(i) <- 1. ;

 m ;;




(** 
oblique_float numrows numcolumns
 *)


let oblique_float = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0.

 and s = ( min r c ) - 1 in

  for i = 0 to s do

   m.(i).(s - i) <- 1.

  done ;

  m ;;




(** 
oblique_float_bis numrows numcolumns
 *)


let oblique_float_bis = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0.

 and s = ( min r c ) - 1

 and delta = Util.int_max 0 (c - r) in

  for i = 0 to ( min r c ) - 1 do

   m.(i).( s - i + delta ) <- 1.

  done ;

  m ;;




(** 
oblique_float_ter numrows numcolumns
 *)


let oblique_float_ter = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0.

 and s = ( min r c ) - 1

 and delta = Util.int_max 0 (r - c) in

  for i = 0 to ( min r c ) - 1 do

   m.( i + delta ).(s - i) <- 1.

  done ;

  m ;;






(** 
antiscal_float numrows numcolumns real
 *)


let antiscal_float = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0.

 and s = ( min r c ) - 1 in

  for i = 0 to s do

   m.(i).(s-i) <- x

  done ;

  m ;;




(** 
antiscal_float_bis numrows numcolumns real
 *)


let antiscal_float_bis = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0.

 and s = ( min r c ) - 1

 and delta = Util.int_max 0 (c - r) in

  for i = 0 to ( min r c ) - 1 do

   m.(i).( s - i + delta ) <- x

  done ;

  m ;;




(** 
antiscal_float_ter numrows numcolumns real
 *)


let antiscal_float_ter = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0.

 and s = ( min r c ) - 1

 and delta = Util.int_max 0 (r - c) in

  for i = 0 to ( min r c ) - 1 do

   m.( i + delta ).(s-i) <- x

  done ;

  m ;;






(** 
antidiag_float numrows numcolumns
 *)


let antidiag_float = function (v:float array) ->

 let r = Array.length v in

  let m = Array.make_matrix r r 0. in

   for i = 0 to r - 1 do

    m.(i).(r - 1 - i) <- v.(i)

   done ;

   m ;;




(** 
antidiag_inv_float numrows numcolumns
 *)


let antidiag_inv_float = function (v:float array) ->

 let r = Array.length v in

  let m = Array.make_matrix r r 0. in

   for i = 0 to r - 1 do

    begin

     let x = v.(i) in

      if x == 0. then failwith "Division by zero in Matrix.antidiag_inv_float." ;

      m.(i).(r - 1 - i) <- 1. /. x

    end

   done ;

   m ;;






(** 
matrix_float_serret_frenet vector
 *)


let matrix_float_serret_frenet = function (v:float array) ->

 let r = Array.length v in

  let rr = r + 1

  and r_r = r - 1 in

   let m = Array.make_matrix rr rr 0. in

    m.(0).(1) <- v.(0) ;

    for i = 1 to r_r do

     let row = m.(i) in

      row.( i - 1 ) <- -. v.( i - 1 ) ;

      row.( i + 1 ) <- v.(i) ;

    done ;

    m.(r).(r_r) <- -. v.(r_r) ;

    m ;;




(** 
vector_float_random size range
 *)


let vector_float_random = fun n x ->

 let v = Array.make n 0. in

  for i = 0 to n - 1 do

   v.(i) <- Random.float x

 done ;

 v ;;




(** 
vector_float_sign_random size
 *)


let vector_float_sign_random = function n ->

 let v = Array.make n 0. in

  for i = 0 to n - 1 do

   v.(i) <- if Random.bool() then 1. else -1.

 done ;

 v ;;




(** 
vector_float_random_progression size range
 *)


let vector_float_random_progression = fun n x ->

 let v = vector_float_random n x in

  for i = 1 to n - 1 do

   v.(i) <- v.(i - 1) +. v.(i)

  done ;

  v ;;




(** 
vector_float_bal_random size range
 *)


let vector_float_bal_random = fun n x ->

 let v = Array.make n 0.

 and y = x *. 2. in

  for i = 0 to n - 1 do

   v.(i) <- (Random.float y) -. x

 done ;

 v ;;








(** 
float_open_equal_subdivision beginning number_of_steps end
 *)


let float_open_equal_subdivision = fun (a:float) (n:int) (b:float) ->

 let x = (b -. a) /. (1. +. float n) in

  let v = Array.make n (a +. x) in

   for i = 1 to n - 1 do

    v.(i) <- v.(i - 1) +. x

   done ;

   v ;;




(** 
float_closed_equal_subdivision beginning number_of_steps end
 *)


let float_closed_equal_subdivision = fun (a:float) (n:int) (b:float) ->

 let x = (b -. a) /. ( (float n) -. 1. )

 and nn = n / 2 in

  let v = Array.make n a in

   for i = 1 to nn do

    v.(i) <- v.(i - 1) +. x

   done ;

   v.(n - 1) <- b ;

   for i = n - 2 downto nn + 1 do

    v.(i) <- v.(i + 1) -. x

   done ;

   v ;;






(** 
float_closed_open_equal_subdivision beginning number_of_steps end
 *)


let float_closed_open_equal_subdivision = fun (a:float) (n:int) (b:float) ->

 let x = (b -. a) /. (float n) in

  let v = Array.make n a in

   for i = 1 to n - 1 do

    v.(i) <- v.(i - 1) +. x

   done ;

   v ;;




(** 
float_open_closed_equal_subdivision beginning number_of_steps end
 *)


let float_open_closed_equal_subdivision = fun (a:float) (n:int) (b:float) ->

 let x = (b -. a) /. (float n) in

  let v = Array.make n b in

   for i = n - 2 downto 0 do

    v.(i) <- v.(i + 1) -. x

   done ;

   v ;;






(** 
float_open_equal_range beginning step end
 *)


let float_open_equal_range = fun (a:float) (x:float) (b:float) ->

 let n = Util.round ( (b -. a) /. x ) - 1 in

  let v = Array.make n (a +. x) in

   for i = 1 to n - 1 do

    v.(i) <- v.(i - 1) +. x

   done ;

   v ;;




(** 
float_closed_equal_range beginning step end
 *)


let float_closed_equal_range = fun (a:float) (x:float) (b:float) ->

 let n = Util.round ( (b -. a) /. x ) + 1 in

  let nn = n / 2 in

   let v = Array.make n a in

    for i = 1 to nn do

     v.(i) <- v.(i - 1) +. x

    done ;

    v.(n - 1) <- b ;

    for i = n - 2 downto nn + 1 do

     v.(i) <- v.(i + 1) -. x

    done ;

    v ;;




(** 
float_closed_open_equal_range beginning step end
 *)


let float_closed_open_equal_range = fun (a:float) (x:float) (b:float) ->

 let n = Util.round ( (b -. a) /. x ) in

  let v = Array.make n a in

   for i = 1 to n - 1 do

    v.(i) <- v.(i - 1) +. x

   done ;

   v ;;




(** 
float_open_closed_equal_range beginning step end
 *)


let float_open_closed_equal_range = fun (a:float) (x:float) (b:float) ->

 let n = Util.round ( (b -. a) /. x ) in

  let v = Array.make n b in

   for i = n - 2 downto 0 do

    v.(i) <- v.(i + 1) -. x

   done ;

   v ;;






(** 
float_open_random_subdivision beginning number_of_steps end
 *)


let float_open_random_subdivision = fun (a:float) (n:int) (b:float) ->

 let v = vector_float_random_progression (n + 1) 1. in

  let x = (b -. a) /. v.(n) in

   for i = 0 to n - 1 do

    v.(i) <- a +. x *. v.(i)

   done ;

   Array.sub v 0 n ;;




(** 
float_closed_random_subdivision beginning number_of_steps end
 *)


let float_closed_random_subdivision = fun (a:float) (n:int) (b:float) ->

 let v = vector_float_random_progression (n - 1) 1. in

  let x = (b -. a) /. v.(n - 2) in

   for i = n - 2 downto 1 do

    v.(i) <- a +. x *. v.(i - 1)

   done ;

   v.(0) <- a ;

   Array.append v [|b|] ;;




(** 
float_closed_open_random_subdivision beginning number_of_steps end
 *)


let float_closed_open_random_subdivision = fun (a:float) (n:int) (b:float) ->

 let v = vector_float_random_progression n 1. in

  let x = (b -. a) /. v.(n - 1) in

   for i = n - 1 downto 1 do

    v.(i) <- a +. x *. v.(i - 1)

   done ;

   v.(0) <- a ;

   v ;;




(** 
float_open_closed_random_subdivision beginning number_of_steps end
 *)


let float_open_closed_random_subdivision = fun (a:float) (n:int) (b:float) ->

 let v = vector_float_random_progression n 1. in

  let x = (b -. a) /. v.(n - 1) in

   for i = 0 to n - 2 do

    v.(i) <- a +. x *. v.(i)

   done ;

   v.(n - 1) <- b ;

   v ;;








(** 
matrix_float_random rows columns range
 *)


let matrix_float_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0.

 and cc = c - 1 in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = 0 to cc do

     row.(j) <- Random.float x

    done

  done ;

  m ;;




(** 
matrix_float_bal_random rows columns range
 *)


let matrix_float_bal_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0. 

 and y = x *. 2.

 and cc = c - 1 in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = 0 to cc do

     row.(j) <- (Random.float y) -. x

    done

  done ;

  m ;;




(** 
upper_trig_float_random rows columns range
 *)


let upper_trig_float_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0.

 and cc = c - 1 in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = i to cc do

     row.(j) <- Random.float x

    done

  done ;

  m ;;




(** 
upper_trig_float_bal_random rows columns range
 *)


let upper_trig_float_bal_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0. 

 and y = x *. 2.

 and cc = c - 1 in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = i to cc do

     row.(j) <- (Random.float y) -. x

    done

  done ;

  m ;;




(** 
lower_trig_float_random rows columns range
 *)


let lower_trig_float_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0. in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = 0 to i do

     row.(j) <- Random.float x

    done

  done ;

  m ;;




(** 
lower_trig_float_bal_random rows columns range
 *)


let lower_trig_float_bal_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0. 

 and y = x *. 2. in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = 0 to i do

     row.(j) <- (Random.float y) -. x

    done

  done ;

  m ;;




(** 
upper_nil_float_random rows columns range
 *)


let upper_nil_float_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0.

 and cc = c - 1 in

  for i = 0 to r - 2 do

   let row = m.(i) in

    for j = i + 1 to cc do

     row.(j) <- Random.float x

    done

  done ;

  m ;;




(** 
upper_nil_float_bal_random rows columns range
 *)


let upper_nil_float_bal_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0. 

 and y = x *. 2.

 and cc = c - 1 in

  for i = 0 to r - 2 do

   let row = m.(i) in

    for j = i + 1 to cc do

     row.(j) <- (Random.float y) -. x

    done

  done ;

  m ;;




(** 
lower_nil_float_random rows columns range
 *)


let lower_nil_float_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0. in

  for i = 1 to r - 1 do

   let row = m.(i) in

    for j = 0 to i - 1 do

     row.(j) <- Random.float x

    done

  done ;

  m ;;




(** 
lower_nil_float_bal_random rows columns range
 *)


let lower_nil_float_bal_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0. 

 and y = x *. 2. in

  for i = 1 to r - 1 do

   let row = m.(i) in

    for j = 0 to i - 1 do

     row.(j) <- (Random.float y) -. x

    done

  done ;

  m ;;






(** 
upper_unip_float_random rows columns range
 *)


let upper_unip_float_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0.

 and cc = c - 1 in

  for i = 0 to r - 2 do

   let row = m.(i) in

    row.(i) <- 1. ;

    for j = i + 1 to cc do

     row.(j) <- Random.float x

    done

  done ;

  let rr = pred r in

   m.(rr).(rr) <- 1. ;

   m ;;




(** 
upper_unip_float_bal_random rows columns range
 *)


let upper_unip_float_bal_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0. 

 and y = x *. 2.

 and cc = c - 1 in

  for i = 0 to r - 2 do

   let row = m.(i) in

    row.(i) <- 1. ;

    for j = i + 1 to cc do

     row.(j) <- (Random.float y) -. x

    done

  done ;

  let rr = pred r in

   m.(rr).(rr) <- 1. ;

   m ;;




(** 
lower_unip_float_random rows columns range
 *)


let lower_unip_float_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0. in

  m.(0).(0) <- 1. ;

  for i = 1 to r - 1 do

   let row = m.(i) in

    for j = 0 to i - 1 do

     row.(j) <- Random.float x

    done ;

    row.(i) <- 1.

  done ;

  m ;;




(** 
lower_unip_float_bal_random rows columns range
 *)


let lower_unip_float_bal_random = fun (r:int) (c:int) (x:float) ->

 let m = Array.make_matrix r c 0. 

 and y = x *. 2. in

  m.(0).(0) <- 1. ;

  for i = 1 to r - 1 do

   let row = m.(i) in

    for j = 0 to i - 1 do

     row.(j) <- (Random.float y) -. x

    done ;

    row.(i) <- 1.

  done ;

  m ;;






(** 
matrix_float_binome rank
 The Pascal triangle in floating point output.



Le triangle de Pascal en sortie réelle. *)


let rec matrix_float_binome = function n ->

 match n with

 | 0 -> [|[|1.|]|]

 | 1 -> [| [|1.|] ; [| 1. ; 1. |] |]

 | _ -> let m = matrix_float_binome (n - 1)

  and v = Array.make ( n + 1 ) 1. in

   let row = m.( n - 1 ) in

    for i = 1 to n - 1 do

     v.(i) <- row.(i - 1) +. row.(i)

    done ;

    Array.append m [| v |] ;;






(** 
matrix_float_Vandermonde vector
 The real Vandermonde matrix.



La matrice de Vandermonde réelle. *)


let matrix_float_Vandermonde = function v ->

 let n = Array.length v in

  let m = Array.make_matrix n n 1. in

   for i = 0 to n - 1 do

    let row = m.(i)

    and xi = v.(i) in

     for j = 1 to n - 1 do

      row.(j) <- row.(j - 1) *. xi

     done

   done ;

   m ;;






(** 
matrix_float_nil order
 The model nilpotent real matrix of order n and rank n - 1.



La matrice nilpotente modèle réelle d'ordre n et de rang n - 1. *)


let matrix_float_nil = function n ->

 let m = Array.make_matrix n n 0. in

  for i = 0 to n - 2 do

   m.(i).(i + 1) <- 1.

  done ;

  m ;;






(** 
matrix_float_Jordan order coefficient
 The real Jordan block of order n.



Le bloc de Jordan réel d'ordre n. *)


let matrix_float_Jordan = fun n x ->

 let m =Array.make_matrix n n 0. in

  for i = 0 to n - 2 do

   let row = m.(i) in

    row.(i) <- x ;

    row.(i + 1) <- 1.

  done ;

  m.(n - 1).(n - 1) <- x ;

  m ;;








(** 
zeros_int matrix
 *)


let zeros_int = function (m:int array array) ->

 let r = numrows m and c = numcolumns m in

 Array.make_matrix r c 0 ;;




(** 
null_int numrows numcolumns
 *)


let null_int = fun (r:int) (c:int) ->

 Array.make_matrix r c 0 ;;




(** 
ones_int matrix
 *)


let ones_int = function (m:int array array) ->

 let r = numrows m and c = numcolumns m in

 Array.make_matrix r c 1 ;;




(** 
units_int numrows numcolumns
 *)


let units_int = fun (r:int) (c:int) ->

 Array.make_matrix r c 1 ;;




(** 
fill_int matrix
 *)


let fill_int = fun (m:int array array) (x:int) ->

 Array.make_matrix (Array.length m) (Array.length m.(0)) x ;;




(** 
saturate_int numrows numcolumns integer
 *)


let saturate_int = fun (r:int) (c:int) x ->

 Array.make_matrix r c x ;;






(** 
identity_int numrows numcolumns
 *)


let identity_int = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0 in

  for i = 0 to ( min r c ) - 1 do

   m.(i).(i) <- 1

  done ;

  m ;;




(** 
identity_int_bis numrows numcolumns
 *)


let identity_int_bis = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0 

 and delta = Util.int_max 0 (c - r) in

  for i = 0 to ( min r c ) - 1 do

   m.(i).( i + delta ) <- 1

  done ;

  m ;;




(** 
identity_int_ter numrows numcolumns
 *)


let identity_int_ter = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0 

 and delta = Util.int_max 0 (r - c) in

  for i = 0 to ( min r c ) - 1 do

   m.( i + delta ).(i) <- 1

  done ;

  m ;;






(** 
rank_int_matrix numrows numcolumns rank
 *)


let rank_int_matrix =  fun (r:int) (c:int) (rank:int) ->

 let m = Array.make_matrix r c 0 in

  for i = 0 to rank - 1 do

   m.(i).(i) <- 1

  done ;

  m ;;






(** 
eye_int matrix
 *)


let eye_int = function (m:int array array) ->

 identity_int (Array.length m) (Array.length m.(0)) ;;




(** 
eye_int_bis matrix
 *)


let eye_int_bis = function (m:int array array) ->

 identity_int_bis (Array.length m) (Array.length m.(0)) ;;




(** 
eye_int_ter matrix
 *)


let eye_int_ter = function (m:int array array) ->

 identity_int_ter (Array.length m) (Array.length m.(0)) ;;






(** 
scal_int numrows numcolumns integer
 *)


let scal_int = fun (r:int) (c:int) (x:int) ->

  let m = Array.make_matrix r c 0 in

   for i = 0 to ( min r c ) - 1 do

    m.(i).(i) <- x

   done ;

 m ;;




(** 
scal_int_bis numrows numcolumns integer
 *)


let scal_int_bis = fun (r:int) (c:int) (x:int) ->

 let m = Array.make_matrix r c 0

 and delta = Util.int_max 0 (c - r) in

  for i = 0 to ( min r c ) - 1 do

   m.(i).( i + delta ) <- x

  done ;

  m ;;




(** 
scal_int_ter numrows numcolumns integer
 *)


let scal_int_ter = fun (r:int) (c:int) (x:int) ->

 let m = Array.make_matrix r c 0

 and delta = Util.int_max 0 (r - c) in

  for i = 0 to ( min r c ) - 1 do

   m.( i + delta ).(i) <- x

  done ;

  m ;;






(** 
diag_int vector
 *)


let diag_int = function (v:int array) ->

 let r = Array.length v in

  let m = Array.make_matrix r r 0 in

   for i = 0 to r - 1 do

    m.(i).(i) <- v.(i)

   done ;

 m ;;




(** 
matrix_int_permu size index1 index2
 *)


let matrix_int_permu = fun n i j ->

 let m = identity_int n n in

   m.(i).(i) <- 0 ;

   m.(j).(j) <- 0 ;

   m.(i).(j) <- 1 ;

   m.(j).(i) <- 1 ;

 m ;;




(** 
oblique_int numrows numcolumns
 *)


let oblique_int = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0

 and s = ( min r c ) - 1 in

  for i = 0 to s do

   m.(i).(s-i) <- 1

  done ;

  m ;;




(** 
oblique_int_bis numrows numcolumns
 *)


let oblique_int_bis = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0

 and s = ( min r c ) - 1

 and delta = Util.int_max 0 (c - r) in

  for i = 0 to ( min r c ) - 1 do

   m.(i).( s - i + delta ) <- 1

  done ;

  m ;;




(** 
oblique_int_ter numrows numcolumns
 *)


let oblique_int_ter = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c 0

 and s = ( min r c ) - 1

 and delta = Util.int_max 0 (r - c) in

  for i = 0 to ( min r c ) - 1 do

   m.( i + delta ).(s-i) <- 1

  done ;

  m ;;






(** 
antiscal_int numrows numcolumns integer
 *)


let antiscal_int = fun (r:int) (c:int) (x:int) ->

 let m = Array.make_matrix r c 0

 and s = ( min r c ) - 1 in

  for i = 0 to s do

   m.(i).(s-i) <- x

  done ;

  m ;;




(** 
antiscal_int_bis numrows numcolumns integer
 *)


let antiscal_int_bis = fun (r:int) (c:int) (x:int) ->

 let m = Array.make_matrix r c 0

 and s = ( min r c ) - 1

 and delta = Util.int_max 0 (c - r) in

  for i = 0 to ( min r c ) - 1 do

   m.(i).( s - i + delta ) <- x

  done ;

  m ;;




(** 
antiscal_int_ter numrows numcolumns integer
 *)


let antiscal_int_ter = fun (r:int) (c:int) (x:int) ->

 let m = Array.make_matrix r c 0

 and s = ( min r c ) - 1

 and delta = Util.int_max 0 (r - c) in

  for i = 0 to ( min r c ) - 1 do

   m.( i + delta ).(s-i) <- x

  done ;

  m ;;






(** 
antidiag_int numrows numcolumns
 *)


let antidiag_int = function (v:int array) ->

 let r = Array.length v in

  let m = Array.make_matrix r r 0 in

   for i = 0 to r - 1 do

    m.(i).(r - 1 - i) <- v.(i)

   done ;

   m ;;




(** 
vector_int_random size range
 *)


let vector_int_random = fun n x ->

 let v = Array.make n 0 in

  for i = 0 to n - 1 do

   v.(i) <- Random.int x

 done ;

 v ;;




(** 
vector_int_sign_random size
 *)


let vector_int_sign_random = function n ->

 let v = Array.make n 0 in

  for i = 0 to n - 1 do

   v.(i) <- if Random.bool() then 1 else -1

 done ;

 v ;;




(** 
vector_int_random_progression size range
 *)


let vector_int_random_progression = fun n x ->

 let v = vector_int_random n x in

  for i = 1 to n - 1 do

   v.(i) <- v.(i - 1) + v.(i)

  done ;

  v ;;




(** 
vector_int_bal_random size range
 *)


let vector_int_bal_random = fun n x ->

 let v = Array.make n 0

 and y = x * 2 in

  for i = 0 to n - 1 do

   v.(i) <- (Random.int y) - x

 done ;

 v ;;






(** 
int_equal_range beginning step number_of_samples
 *)


let int_equal_range = fun (a:int) (s:int) (n:int) ->

 let v = Array.make n a in

  for i = 1 to pred n do

   v.(i) <- v.(i) + i * s ;

  done ;

  v ;;






(** 
matrix_int_random rows columns range
 *)


let matrix_int_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0 in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = 0 to c - 1 do

     row.(j) <- Random.int x

    done

  done ;

  m ;;




(** 
matrix_int_bal_random rows columns range
 *)


let matrix_int_bal_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0 

 and y = x * 2 in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = 0 to c - 1 do

     row.(j) <- (Random.int y) - x

    done

  done ;

  m ;;






(** 
upper_trig_int_random rows columns range
 *)


let upper_trig_int_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0

 and cc = c - 1 in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = i to cc do

     row.(j) <- Random.int x

    done

  done ;

  m ;;




(** 
upper_trig_int_bal_random rows columns range
 *)


let upper_trig_int_bal_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0 

 and y = x * 2

 and cc = c - 1 in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = i to cc do

     row.(j) <- (Random.int y) - x

    done

  done ;

  m ;;




(** 
lower_trig_int_random rows columns range
 *)


let lower_trig_int_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0 in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = 0 to i do

     row.(j) <- Random.int x

    done

  done ;

  m ;;




(** 
lower_trig_int_bal_random rows columns range
 *)


let lower_trig_int_bal_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0 

 and y = x * 2 in

  for i = 0 to r - 1 do

   let row = m.(i) in

    for j = 0 to i do

     row.(j) <- (Random.int y) - x

    done

  done ;

  m ;;




(** 
upper_nil_int_random rows columns range
 *)


let upper_nil_int_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0

 and cc = c - 1 in

  for i = 0 to r - 2 do

   let row = m.(i) in

    for j = i + 1 to cc do

     row.(j) <- Random.int x

    done

  done ;

  m ;;




(** 
upper_nil_int_bal_random rows columns range
 *)


let upper_nil_int_bal_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0 

 and y = x * 2

 and cc = c - 1 in

  for i = 0 to r - 2 do

   let row = m.(i) in

    for j = i + 1 to cc do

     row.(j) <- (Random.int y) - x

    done

  done ;

  m ;;




(** 
lower_nil_int_random rows columns range
 *)


let lower_nil_int_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0 in

  for i = 1 to r - 1 do

   let row = m.(i) in

    for j = 0 to i - 1 do

     row.(j) <- Random.int x

    done

  done ;

  m ;;




(** 
lower_nil_int_bal_random rows columns range
 *)


let lower_nil_int_bal_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0 

 and y = x * 2 in

  for i = 1 to r - 1 do

   let row = m.(i) in

    for j = 0 to i - 1 do

     row.(j) <- (Random.int y) - x

    done

  done ;

  m ;;






(** 
upper_unip_int_random rows columns range
 *)


let upper_unip_int_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0

 and cc = c - 1 in

  for i = 0 to r - 2 do

   let row = m.(i) in

    row.(i) <- 1 ;

    for j = i + 1 to cc do

     row.(j) <- Random.int x

    done

  done ;

  let rr = pred r in

   m.(rr).(rr) <- 1 ;

   m ;;




(** 
upper_unip_int_bal_random rows columns range
 *)


let upper_unip_int_bal_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0 

 and y = x * 2

 and cc = c - 1 in

  for i = 0 to r - 2 do

   let row = m.(i) in

    row.(i) <- 1 ;

    for j = i + 1 to cc do

     row.(j) <- (Random.int y) - x

    done

  done ;

  let rr = pred r in

   m.(rr).(rr) <- 1 ;

   m ;;




(** 
lower_unip_int_random rows columns range
 *)


let lower_unip_int_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0 in

  m.(0).(0) <- 1 ;

  for i = 1 to r - 1 do

   let row = m.(i) in

    for j = 0 to i - 1 do

     row.(j) <- Random.int x

    done ;

    row.(i) <- 1

  done ;

  m ;;




(** 
lower_unip_int_bal_random rows columns range
 *)


let lower_unip_int_bal_random = fun (r:int) (c:int) x ->

 let m = Array.make_matrix r c 0 

 and y = x * 2 in

  m.(0).(0) <- 1 ;

  for i = 1 to r - 1 do

   let row = m.(i) in

    for j = 0 to i - 1 do

     row.(j) <- (Random.int y) - x

    done ;

    row.(i) <- 1

  done ;

  m ;;






(** 
matrix_int_binome rank
 The Pascal triangle in integer output.



Le triangle de Pascal en sortie entière. *)


let rec matrix_int_binome = function n ->

 match n with

 | 0 -> [|[|1|]|]

 | 1 -> [| [|1|] ; [| 1 ; 1 |] |]

 | _ -> let m = matrix_int_binome (n - 1)

  and v = Array.make ( n + 1 ) 1 in

   let row = m.( n - 1 ) in

    for i = 1 to n - 1 do

     v.(i) <- row.(i - 1) + row.(i)

    done ;

    Array.append m [| v |] ;;






(** 
matrix_int_Vandermonde vector
 The integer Vandermonde matrix.



La matrice de Vandermonde entière. *)


let matrix_int_Vandermonde = function v ->

 let n = Array.length v in

  let m = Array.make_matrix n n 1 in

   for i = 0 to n - 1 do

    let row = m.(i)

    and xi = v.(i) in

     for j = 1 to n - 1 do

      row.(j) <- row.(j - 1) * xi

     done

   done ;

   m ;;






(** 
matrix_int_nil order
 The model nilpotent integer matrix of order n and rank n - 1.



La matrice nilpotente modèle entière d'ordre n et de rang n - 1. *)


let matrix_int_nil = function n ->

 let m =Array.make_matrix n n 0 in

  for i = 0 to n - 2 do

   m.(i).(i + 1) <- 1

  done ;

  m ;;






(** 
matrix_int_Jordan order coefficient
 The integer Jordan block of order n.



Le bloc de Jordan entier d'ordre n. *)


let matrix_int_Jordan = fun n x ->

 let m =Array.make_matrix n n 0 in

  for i = 0 to n - 2 do

   let row = m.(i) in

    row.(i) <- x ;

    row.(i + 1) <- 1

  done ;

  m.(n - 1).(n - 1) <- x ;

  m ;;










(** 
§ 
 *)



(** 

Calcul élémentaire sur les matrices réelles


Elementary calculus for real matrices

*)



(** 
 
 *)











(** 
vector_float_copy vector
 *)


let vector_float_copy = function (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    vv.(i) <- v.(i)

   done ;

   vv ;;




(** 
vector_float_clip vector
 *)


let vector_float_clip = fun (x:float) (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    vv.(i) <- min x v.(i)

   done ;

   vv ;;




(** 
vector_float_crest real vector
 *)


let vector_float_crest = fun (x:float) (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    let y = v.(i) in

     if y > x then

      vv.(i) <- y -. x

   done ;

   vv ;;




(** 
vector_float_gully real vector
 *)


let vector_float_gully = fun (x:float) (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    let y = v.(i) in

     if y < x then

      vv.(i) <- x -. y

   done ;

   vv ;;




(** 
other_vector_float_copy vector
 *)


let other_vector_float_copy = function (v:float array) ->

  let vv = Array.make (Array.length v) 0. in

   for i = 0 to (Array.length v) - 1 do

    vv.(i) <- v.(i)

   done ;

   vv ;;




(** 
matrix_float_copy vector
 *)


let matrix_float_copy = function (m:float array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do    

     row_output.(j) <- row_input.(j)

    done

  done ;

  mm ;;




(** 
matrix_float_clip vector
 *)


let matrix_float_clip = fun (x:float) (m:float array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- min x row_input.(j)

    done

  done ;

  mm ;;




(** 
matrix_float_crest real vector
 *)


let matrix_float_crest = fun (x:float) (m:float array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     let y = row_input.(j) in

      if y > x then

       row_output.(j) <- y -. x

    done

  done ;

  mm ;;




(** 
matrix_float_gully real vector
 *)


let matrix_float_gully = fun (x:float) (m:float array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     let y = row_input.(j) in

      if y < x then

       row_output.(j) <- x -. y

    done

  done ;

  mm ;;






(** 
float_sub_matrix matrix beg-row end-row beg-col end-col
 *)


let float_sub_matrix = fun (m:float array array) i ii j jj ->


(** i et j : beginning: début ; ii et jj : end: fin *)


 let mm = Array.make_matrix (ii - i + 1) (jj - j + 1) 0. in

  for index = i to ii do

   let row_input = m.(index)

   and row_output = mm.(index - i) in

    for indice = j to jj do

     row_output.(indice - j) <- row_input.(indice)

    done

  done ;

 mm ;;






(** 
int_of_vector vector
 *)


let int_of_vector = function (v:float array) ->

 let vv = Array.make (Array.length v) 0 in

  for i = 0 to (Array.length v) - 1 do

   vv.(i) <- int_of_float v.(i)

  done ;

  vv ;;




(** 
int_of_matrix matrix
 *)


let int_of_matrix = function (m:float array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do    

     row_output.(j) <- int_of_float row_input.(j)

    done

  done ;

  mm ;;




(** 
vector_float_round vector
 *)


let vector_float_round = function (v:float array) ->

 let vv = Array.make (Array.length v) 0 in

  for i = 0 to (Array.length v) - 1 do

   vv.(i) <- Util.round v.(i)

  done ;

  vv ;;




(** 
matrix_float_round matrix
 *)


let matrix_float_round = function (m:float array array) ->

 let r = Array.length m

 and cc = Array.length m.(0) - 1 in

  let mm = Array.make_matrix r (Array.length m.(0)) 0 in

   for i = 0 to (Array.length m) - 1 do

    let row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do

      row_output.(j) <- Util.round row_input.(j)

     done

    done ;

    mm ;;




(** 
matrix_float_apply function matrix
 *)


let matrix_float_apply = fun (f:float -> float) (m:float array array) ->

 let r = Array.length m

 and cc = Array.length m.(0) - 1 in

  let mm = Array.make_matrix r (Array.length m.(0)) 0. in

   for i = 0 to (Array.length m) - 1 do

    let row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do

      row_output.(j) <- f row_input.(j)

     done

    done ;

    mm ;;






(** 
float_transpose matrix
 *)


let float_transpose = function (m:float array array) ->

 let r = Array.length m

 and c = Array.length m.(0) in

  let mm = Array.make_matrix c r 0.

  and cc = c - 1 in

   for i = 0 to r - 1 do

    let row_input = m.(i) in

    for j = 0 to cc do

     mm.(j).(i) <- row_input.(j)

    done

   done ;  

  mm;;






(** 
vector_float_max vector
 *)


let vector_float_max = function (v:float array) ->

 let accu = ref v.(0) in

  for i = 0 to (Array.length v) - 1 do

   accu := max v.(i) !accu

  done ;

  !accu ;;




(** 
matrix_float_max_by_row matrix
 matrix_float_max_by_row even for lacunar matrices:



matrix_float_max_by_row fonctionne même pour les matrices lacunaires. *)


let matrix_float_max_by_row = function (m:float array array) ->

 let accu = Array.make (Array.length m) (-. max_float) in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i)

   and accumul = ref accu.(i) in

    for j = 0 to (Array.length row) - 1 do

     accumul := max row.(j) !accumul

    done ;

    accu.(i) <- !accumul

  done ;

  accu ;;




(** 
matrix_float_max_by_column matrix
 *)


let matrix_float_max_by_column = function (m:float array array) ->

 let cc = (numcolumns m) - 1 in

  let accu = Array.make (cc + 1) (-. max_float) in

   for j = 0 to cc do

    let accumul = ref accu.(j) in

     for i = 0 to ( (Array.length m) - 1 ) do

      accumul := max m.(i).(j) !accumul

     done ;

     accu.(j) <- !accumul

   done ;

  accu ;;




(** 
matrix_float_max matrix
 *)


let matrix_float_max = function (m:float array array) ->

 let accu = ref (-. max_float) in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i) in

    for j = 0 to (Array.length row) - 1 do

     accu := max row.(j) !accu

    done

  done ;

  !accu ;;






(** 
vector_float_min vector
 *)


let vector_float_min = function (v:float array) ->

 let accu = ref v.(0) in

  for i = 0 to (Array.length v) - 1 do

   accu := min v.(i) !accu

  done ;

  !accu ;;




(** 
matrix_float_min_by_row matrix
 matrix_float_min_by_row even for lacunar matrices:



matrix_float_min_by_row fonctionne même pour les matrices lacunaires. *)


let matrix_float_min_by_row = function (m:float array array) ->

 let accu = Array.make (Array.length m) (-. min_float) in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i)

   and accumul = ref accu.(i) in

    for j = 0 to (Array.length row) - 1 do

     accumul := min row.(j) !accumul

    done ;

    accu.(i) <- !accumul

  done ;

  accu ;;




(** 
matrix_float_min_by_column matrix
 *)


let matrix_float_min_by_column = function (m:float array array) ->

 let cc = (numcolumns m) - 1 in

  let accu = Array.make (cc + 1) (-. min_float) in

   for j = 0 to cc do

    let accumul = ref accu.(j) in

     for i = 0 to ( (Array.length m) - 1 ) do

      accumul := min m.(i).(j) !accumul

     done ;

     accu.(j) <- !accumul

   done ;

  accu ;;




(** 
matrix_float_min matrix
 *)


let matrix_float_min = function (m:float array array) ->

 let accu = ref (-. min_float) in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i) in

    for j = 0 to (Array.length row) - 1 do

     accu := min row.(j) !accu

    done

  done ;

  !accu ;;






(** 
vector_float_find_last element vector
 vector_float_find_last returns -1 if it does not find:



vector_float_find_last retourne -1 s'il ne trouve pas. *)


let vector_float_find_last = fun x (v:float array) ->

 let index = ref (-1) in

  let i = ref ( (Array.length v) - 1 ) in

   while  !i >= 0 do

    if x = v.(!i) then (index := !i ; i := -1) else i := !i - 1 ; 

   done ;

   !index ;;






(** 
vector_float_find_first element vector
 vector_float_find_first returns -1 if it does not find:



vector_float_find_first retourne -1 s'il ne trouve pas. *)


let vector_float_find_first = fun x (v:float array) ->

 let index = ref (-1)

 and i = ref 0 in

  while  !i < Array.length v do

   if x = v.(!i) then (index := !i ; i := Array.length v ) else i := !i + 1 ; 

  done ;

 !index ;;






(** 
vector_float_find_twin element vector
 vector_float_find_first returns -1 if it does not find:



vector_float_find_twin retourne -1 s'il ne trouve pas. *)


let vector_float_find_twin = fun x (v:float array) ->

 let index = ref (-1)

 and i = ref 0 in

  while  !i <= min ((Array.length v) - 1) ( int_of_float ( ceil ( (float (Array.length v)) /. 2. ) ) )  do

   if x = v.(!i) then (index := !i ; i := 1 + Array.length v )

   else

    begin

     let j = (Array.length v) - 1 - !i in

     if x = v.(j) then ( index := j ; i := 1 + Array.length v ) else i := !i + 1 ; 

    end

  done ;

 !index ;;






(** 
vector_float_find_all element vector
 vector_float_find_all returns [||]  if it does not find:



vector_float_find_all retourne [||] s'il ne trouve pas.*)


let vector_float_find_all = fun x (v:float array) ->

 let index = ref [||] in

  for i = 0 to (Array.length v) - 1 do

   if (x = v.(i)) then (index := Array.append !index [|i|] ; ())

  done ;

 !index ;;






(** 
matrix_float_find_last element vector
 matrix_float_find_last returns [|-1;-1|] if it does not find:



matrix_float_find_last retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_float_find_last = fun x (m:float array array) ->

 let index = ref (-1) and indice = ref (-1) in

  let i = ref ( (Array.length m) - 1 ) in

   while  !i >= 0 do

    let row = m.(!i) in

     let j = ref ( (Array.length row) - 1 ) in

      while  !j >= 0 do

       if x = row.(!j) then ( indice := !j ; j := -1 ) else j := !j - 1 ; 

      done ;

      if !indice <> -1 then ( index := !i ; i := -1 ) else i := !i - 1 ;

   done ;

   [| !index ; !indice |] ;;






(** 
matrix_float_find_last_first element vector
 matrix_find_last returns [|-1;-1|] if it does not find:



matrix_float_find_last_first retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_float_find_last_first = fun x (m:float array array) ->

 let index = ref (-1) and indice = ref (-1) in

  let i = ref ( ( Array.length m ) - 1 ) in

   while  !i >= 0 do

    let row = m.(!i) in

     let j = ref 0 in

      while  !j < ( Array.length row ) do

       if x = row.(!j) then ( indice := !j ; j := max_int ) else j := !j + 1 ; 

      done ;

      if !indice <> -1 then ( index := !i ; i := -1 ) else i := !i - 1 ;

   done ;

   [| !index ; !indice |] ;;






(** 
matrix_float_find_first element vector
 matrix_find_first returns [|-1;-1|] if it does not find:



matrix_float_find_first retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_float_find_first = fun x (m:float array array) ->

 let index = ref (-1) and indice = ref (-1) in

  let i = ref 0 in

   while  !i < Array.length m do

    let row = m.(!i) in

     let j = ref 0 in

      while  !j < Array.length row do

       if x = row.(!j) then ( indice := !j ; j := Array.length row ) else j := !j + 1 ; 

      done ;

      if !indice <> -1 then ( index := !i ; i := Array.length m ) else i := !i + 1 ;

   done ;

   [| !index ; !indice |] ;;






(** 
matrix_float_find_first_last element vector
 matrix_find_first returns [|-1;-1|] if it does not find:



matrix_float_find_first_last retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_float_find_first_last = fun x (m:float array array) ->

 let index = ref (-1) and indice = ref (-1) in

  let i = ref 0 in

   while  !i < Array.length m do

    let row = m.(!i) in

     let j = ref 0 in

      while  !j >= 0 do

       if x = row.(!j) then ( indice := !j ; j := -1 ) else j := !j - 1 ; 

      done ;

      if !indice <> -1 then ( index := !i ; i := Array.length m ) else i := !i + 1 ;

   done ;

   [| !index ; !indice |] ;;






(** 
matrix_float_find_twin element vector
 matrix_find_twin returns [|-1;-1|] if it does not find:



matrix_float_find_twin retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_float_find_twin = fun x (m:float array array) ->

 let index = ref (-1) and indice = ref (-1) in

  let i = ref 0 in

   while  !i <= min (Array.length m - 1) ( int_of_float ( ceil ( (float (Array.length m)) /. 2. ) ) ) do

    let row = m.(!i) in

     let j = ref 0 in

      while  !j <= min (Array.length row - 1) ( int_of_float ( ceil ( (float (Array.length row)) /. 2. ) ) ) do

       if x = row.(!j) then ( indice := !j ; j := 1 + Array.length row )

       else

        begin

         let k = (Array.length row) - 1 - !j in

         if x = row.(k) then ( indice := k ; j := 1 + Array.length row ) else j := !j + 1 ; 

        end

      done ;

      if !indice <> -1 then ( index := !i ; i := 1 + Array.length m ) else i := !i + 1 ;

   done ;

   [| !index ; !indice |] ;;






(** 
matrix_float_find_all element vector
 matrix_find_all returns [|-1;-1|] if it does not find:



matrix_float_find_all retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_float_find_all = fun x (m:float array array) ->

 let result = ref [||] and index = ref [||] and indice = ref [||] in

  for i = 0 to Array.length m -1 do

   let row = m.(i) in

    for j = 0 to Array.length row -1 do

     if x = row.(j) then ( indice := Array.append !indice [|j|] ; () )

    done ;

    if !indice <> [||] then 

     begin

      index := Array.map (function a -> [| i ; a|]) !indice ; 

      result := Array.append !result !index 

     end

  done ;

  !result ;;






(** 
vector_float_sum vector
 *)


let vector_float_sum = function (v:float array) ->

 let accu = ref 0. in

  for i = 0 to (Array.length v) - 1 do

   accu := v.(i) +. !accu

  done ;

  !accu ;;




(** 
vector_float_contraction vector
 *)


let vector_float_contraction = function (v:float array) ->

 let accu = ref 1. in

  for i = 0 to (Array.length v) - 1 do

   accu := v.(i) *. !accu

  done ;

  !accu ;;




(** 
matrix_float_sum_by_row matrix
 *)


let matrix_float_sum_by_row = function (m:float array array) ->

 let accu = Array.make (Array.length m) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i)

   and accumul = ref accu.(i) in

    for j = 0 to (Array.length row) - 1 do

     accumul := row.(j) +. !accumul

    done ;

    accu.(i) <- !accumul

  done ;

  accu ;;




(** 
matrix_float_sum_by_column matrix
 *)


let matrix_float_sum_by_column = function (m:float array array) ->

 let cc = (numcolumns m) - 1 in

  let accu = Array.make (cc + 1) 0. in

   for j = 0 to cc do

    let accumul = ref accu.(j) in

     for i = 0 to ( (Array.length m) - 1 ) do

      accumul := m.(i).(j) +. !accumul

     done ;

     accu.(j) <- !accumul

   done ;

  accu ;;




(** 
matrix_float_sum matrix
 *)


let matrix_float_sum = function (m:float array array) ->

 let accu = ref 0. in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i) in

    for j = 0 to (Array.length row) - 1 do

     accu := row.(j) +. !accu

    done

  done ;

  !accu ;;




(** 
matrix_float_mean_by_row matrix
 *)


let matrix_float_mean_by_row = function (m:float array array) ->

 let r = Array.length m

 and c = Array.length m.(0) in

  let accu = Array.make r 0. in

   let cc = c - 1 in

    for i = 0 to r - 1 do

     let row = m.(i)

     and accumul = ref accu.(i) in

      for j = 0 to cc do

       accumul := row.(j) +. !accumul

      done ;

      accu.(i) <- !accumul /. (float c)

    done ;

    accu ;;




(** 
matrix_float_mean_by_column matrix
 *)


let matrix_float_mean_by_column = function (m:float array array) ->

 let cc = (numcolumns m) - 1

 and r = Array.length m in

  let accu = Array.make (cc + 1) 0.

  and rr = r - 1 in

   for j = 0 to cc do

    let accumul = ref accu.(j) in

     for i = 0 to rr do

      accumul := m.(i).(j) +. !accumul

     done ;

     accu.(j) <- !accumul /. (float r)

   done ;

  accu ;;






(** 
vector_float_abs vector
 *)


let vector_float_abs = function (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    vv.(i) <- abs_float v.(i)

   done ;

   vv ;;




(** 
matrix_float_abs matrix
 *)


let matrix_float_abs = function (m:float array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do    

     row_output.(j) <- abs_float row_input.(j)

    done

  done ;

  mm ;;




(** 
matrix_float_opp matrix
 *)


let matrix_float_opp = function (m:float array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do    

     row_output.(j) <- -. row_input.(j)

    done

  done ;

  mm ;;






(** 
string_of_vector_float vector
 *)


let string_of_vector_float = function (v:float array) ->

 let rr = pred ( Array.length v )

 and s = ref "[| " in

  for i = 0 to ( rr - 1 ) do

   s := !s ^ ( string_of_float v.(i) ) ^ " ; " 

  done ;

  s := !s ^ ( string_of_float v.(rr) ) ^ " |]" ;

  !s ;;




(** 
vector_float_print vector
 *)


let vector_float_print = function (v:float array) ->

 let s = string_of_vector_float v in

  print_string s ;

  print_newline () ;;




(** 
bare_vector_float_to_string vector
 *)


let bare_vector_float_to_string = function (v:float array) ->

 let rr = pred ( Array.length v )

 and s = ref "[| "  in

  for i = 0 to pred rr do

   s := !s ^ ( string_of_float v.(i) ) ^ " "

  done ;

  s := !s ^ ( string_of_float v.(rr) ) ^ "|]" ;

  !s ;;




(** 
bare_vector_float_print vector
 *)


let bare_vector_float_print = function (v:float array) ->

 let s = bare_vector_float_to_string v in

  print_string s ;;






(** 
vector_float_of_string string
 *)


let vector_float_of_string = function (s:string) ->

 let ls = String.length s in

  let st = String.sub s 3 ( ls - 6 ) in

   let listing = Str.split ( Str.regexp " ; " ) st in

    let a = Array.of_list listing in

     Array.map float_of_string a ;;




(** 
bare_vector_float_of_string string
 *)


let bare_vector_float_of_string = function (s:string) ->

 let ls = String.length s in

  let st = String.sub s 2 ( ls - 4 ) in

   let listing = Str.split ( Str.regexp " " ) st in

    let a = Array.of_list listing in

     Array.map float_of_string a ;;






(** 
matrix_float_to_string matrix
 *)


let matrix_float_to_string = function (m:float array array) ->

 let s = ref "[| with "

 and r = Array.length m

 and c = slow_numcolumns m in

  s := !s ^ string_of_int r ;

  if r > 1 then s := !s ^ " rows"

  else s := !s ^ " row" ;

  s := !s ^ "\n" ;

  s := !s ^ bare_vector_float_to_string m.(0) ^ " ;" ; 

  for i = 1 to ( Array.length m - 1 ) do

   begin

    s := !s ^ "\n" ^ ( bare_vector_float_to_string m.(i) ) ^ " ;"

   end

  done ;

  s := !s ^ "\n|] and " ^ ( string_of_int c ) ;

  if c > 1 then s := !s ^ " columns\n"

  else s := !s ^ " column\n" ;

  !s ;;






(** 
matrix_float_print matrix
 *)


let matrix_float_print = function (m:float array array) ->

 let s = matrix_float_to_string m in

  print_string s ;;






(** 
matrix_float_of_string string
 *)


let matrix_float_of_string = function (s:string) ->

 let ls = String.length s in

  let st = String.sub s 8 ( ls - 8 ) in

   let number_of_rows = 

    begin

     let position = Str.search_forward ( Str.regexp " row" ) st 0 in

      int_of_string ( String.sub st 0 position )

    end in

    let m = Array.make_matrix number_of_rows 0 0.

    and listing = Str.split ( Str.regexp " ;\n" ) s in

     let a = Array.sub ( Array.of_list listing ) 0 number_of_rows in

      for i = 1 to pred number_of_rows do

       m.(i) <- bare_vector_float_of_string a.(i)

      done ;

      let str = List.hd ( List.tl ( Str.split ( Str.regexp "\n" ) a.(0) ) ) in

       m.(0) <- bare_vector_float_of_string str ;

       m ;;






(** 
float_trace matrix
 *)


let float_trace = function (m:float array array) ->

 let r = min (Array.length m) (Array.length m.(0))

 and accumulateur = ref 0. in

  if r > 0 then 

   for i = 0 to r - 1 do

    accumulateur := !accumulateur +. m.(i).(i)

   done ;

  !accumulateur ;;






(** 
vector_float_scal_add coefficient vector
 *)


let vector_float_scal_add = fun (x:float) (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    vv.(i) <- x +. v.(i)

   done ;

   vv ;;




(** 
vector_float_scal_mult coefficient vector
 *)


let vector_float_scal_mult = fun (x:float) (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    vv.(i) <- x *. v.(i)

   done ;

   vv ;;




(** 
vector_float_scal_left_sub coefficient vector
 *)


let vector_float_scal_left_sub = fun (x:float) (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    vv.(i) <- v.(i) -. x

   done ;

   vv ;;




(** 
vector_float_scal_right_sub coefficient vector
 *)


let vector_float_scal_right_sub = fun (x:float) (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    vv.(i) <- x -. v.(i)

   done ;

   vv ;;




(** 
vector_float_scal_left_div coefficient vector
 *)


let vector_float_scal_left_div = fun (x:float) (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    vv.(i) <- v.(i) /. x

   done ;

   vv ;;




(** 
vector_float_scal_right_div coefficient vector
 *)


let vector_float_scal_right_div = fun (x:float) (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    vv.(i) <- x /. v.(i)

   done ;

   vv ;;




(** 
vector_float_opp vector
 *)


let vector_float_opp = fun (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    vv.(i) <- -. v.(i)

   done ;

   vv ;;




(** 
vector_float_inv vector
 *)


let vector_float_inv = fun (v:float array) ->

 let r = Array.length v in

  let vv = Array.make r 0. in

   for i = 0 to r - 1 do

    begin

     let x = v.(i) in

      if x == 0. then failwith "Division by zero in Matrix.vector_float_inv." ;

      vv.(i) <- 1. /. x

    end

   done ;

   vv ;;






(** 
vector_float_plus vector1 vector2
 *)


let vector_float_plus = fun (v:float array) (vv:float array) ->

 let r = Array.length v in

  let vvv = Array.make r 0. in

   for i = 0 to r - 1 do

    vvv.(i) <- v.(i) +. vv.(i)

   done ;

   vvv ;;




(** 
vector_float_minus vector1 vector2
 *)


let vector_float_minus = fun (v:float array) (vv:float array) ->

 let r = Array.length v in

  let vvv = Array.make r 0. in

   for i = 0 to r - 1 do

    vvv.(i) <- v.(i) -. vv.(i)

   done ;

   vvv ;;




(** 
vector_float_coeff_prod vector1 vector2
 *)


let vector_float_coeff_prod = fun (v:float array) (vv:float array) ->

 let r = Array.length v in

  let vvv = Array.make r 0. in

   for i = 0 to r - 1 do

    vvv.(i) <- v.(i) *. vv.(i)

   done ;

   vvv ;;




(** 
vector_float_coeff_div vector1 vector2
 *)


let vector_float_coeff_div = fun (v:float array) (vv:float array) ->

 let r = Array.length v in

  let vvv = Array.make r 0. in

   for i = 0 to r - 1 do

    vvv.(i) <- v.(i) /. vv.(i)

   done ;

   vvv ;;




(** 
vector_float_scal_prod vector1 vector2
 *)


let vector_float_scal_prod = fun (v:float array) (vv:float array) ->

 let x = ref 0. in

  for i = 0 to ( (Array.length v) - 1 ) do

   x := !x +. v.(i) *. vv.(i)

  done ; 

  !x ;;






(** 
partial_float_scal_add beginning end vector1 vector2
 *)


let partial_float_scal_add = fun i j x (v:float array) ->

 let w = Array.make (Array.length v) 0. in

  for k = i to j do

   w.(k) <- v.(k) +. x

  done ;

  w ;;




(** 
part_float_scal_add beginning end vector1 vector2
 *)


let part_float_scal_add = fun i j x (v:float array) ->

 let w = Array.make ( j - i + 1 ) 0. in

   for k = i to j do

    w.(k-i) <- v.(k) +. x

   done ;

   w ;;




(** 
partial_float_scal_mult beginning end vector1 vector2
 *)


let partial_float_scal_mult = fun i j x (v:float array) ->

 let w = Array.make (Array.length v) 0. in

  for k = i to j do

   w.(k) <- v.(k) *. x

  done ;

  w ;;




(** 
part_float_scal_mult beginning end vector1 vector2
 *)


let part_float_scal_mult = fun i j x (v:float array) ->

 let w = Array.make ( j - i + 1 ) 0. in

   for k = i to j do

    w.(k-i) <- v.(k) *. x

   done ;

   w ;;




(** 
partial_float_scal_left_sub beginning end vector1 vector2
 *)


let partial_float_scal_left_sub = fun i j x (v:float array) ->

 let w = Array.make (Array.length v) 0. in

  for k = i to j do

   w.(k) <- v.(k) -. x

  done ;

  w ;;




(** 
part_float_scal_left_sub beginning end vector1 vector2
 *)


let part_float_scal_left_sub = fun i j x (v:float array) ->

 let w = Array.make ( j - i + 1 ) 0. in

   for k = i to j do

    w.(k-i) <- v.(k) -. x

   done ;

   w ;;




(** 
partial_float_scal_right_sub beginning end vector1 vector2
 *)


let partial_float_scal_right_sub = fun i j x (v:float array) ->

 let w = Array.make (Array.length v) 0. in

  for k = i to j do

   w.(k) <- x -. v.(k)

  done ;

  w ;;




(** 
part_float_scal_right_sub beginning end vector1 vector2
 *)


let part_float_scal_right_sub = fun i j x (v:float array) ->

 let w = Array.make ( j - i + 1 ) 0. in

   for k = i to j do

    w.(k-i) <- x -. v.(k)

   done ;

   w ;;




(** 
partial_float_scal_left_div beginning end vector1 vector2
 *)


let partial_float_scal_left_div = fun i j x (v:float array) ->

 let w = Array.make (Array.length v) 0. in

  for k = i to j do

   w.(k) <- v.(k) /. x

  done ;

  w ;;




(** 
part_float_scal_left_div beginning end vector1 vector2
 *)


let part_float_scal_left_div = fun i j x (v:float array) ->

 let w = Array.make ( j - i + 1 ) 0. in

   for k = i to j do

    w.(k-i) <- v.(k) /. x

   done ;

   w ;;




(** 
partial_float_scal_right_div beginning end vector1 vector2
 *)


let partial_float_scal_right_div = fun i j x (v:float array) ->

 let w = Array.make (Array.length v) 0. in

  for k = i to j do

   w.(k) <- x /. v.(k)

  done ;

  w ;;




(** 
part_float_scal_right_div beginning end vector1 vector2
 *)


let part_float_scal_right_div = fun i j x (v:float array) ->

 let w = Array.make ( j - i + 1 ) 0. in

   for k = i to j do

    w.(k-i) <- x /. v.(k)

   done ;

   w ;;






(** 
partial_float_plus beginning end vector1 vector2
 *)


let partial_float_plus = fun i j (v:float array) (vv:float array) ->

 let c = min (Array.length v) (Array.length vv) in

  let w = Array.make c 0. in

   for k = i to j do

    w.(k) <- v.(k) +. vv.(k)

   done ;

   w ;;




(** 
part_float_plus beginning end vector1 vector2
 *)


let part_float_plus = fun i j (v:float array) (vv:float array) ->

 let w =  Array.make ( j - i + 1 ) 0. in

   for k = i to j do

    w.(k-i) <- v.(k) +. vv.(k)

   done ;

   w ;;




(** 
partial_float_minus beginning end vector1 vector2
 *)


let partial_float_minus = fun i j s t ->

 let c = min (Array.length s) (Array.length t) in

  let m = Array.make c 0. in

   for k = i to j do

    m.(k) <- s.(k) -. t.(k)

   done ;

   m ;;




(** 
part_float_minus beginning end vector1 vector2
 *)


let part_float_minus = fun i j (v:float array) (vv:float array) ->

 let w = Array.make ( j - i + 1 ) 0. in

   for k = i to j do

    w.(k-i) <- v.(k) -. vv.(k)

   done ;

   w ;;




(** 
partial_float_coeff_prod beginning end vector1 vector2
 *)


let partial_float_coeff_prod = fun i j (v:float array) (vv:float array) ->

 let c = min (Array.length v) (Array.length vv) in

  let w = Array.make c 0. in

   for k = i to j do

    w.(k) <- v.(k) *. vv.(k)

   done ;

   w ;;




(** 
part_float_coeff_prod beginning end vector1 vector2
 *)


let part_float_coeff_prod = fun i j (v:float array) (vv:float array) ->

 let w = Array.make ( j - i + 1 ) 0. in

   for k = i to j do

    w.(k-i) <- v.(k) *. vv.(k)

   done ;

   w ;;




(** 
partial_float_coeff_div beginning end vector1 vector2
 *)


let partial_float_coeff_div = fun i j (v:float array) (vv:float array) ->

 let c = min (Array.length v) (Array.length vv) in

  let w = Array.make c 0. in

   for k = i to j do

    w.(k) <- v.(k) /. vv.(k)

   done ;

   w ;;




(** 
part_float_coeff_div beginning end vector1 vector2
 *)


let part_float_coeff_div = fun i j (v:float array) (vv:float array) ->

 let w = Array.make ( j - i + 1 ) 0. in

   for k = i to j do

    w.(k-i) <- v.(k) /. vv.(k)

   done ;

   w ;;






(** 
matrix_float_scal_add coefficient matrix
 *)


let matrix_float_scal_add = fun x (m:float array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- x +. row_input.(j)

    done ;

  done ;

  w ;;




(** 
matrix_float_scal_mult coefficient matrix
 *)


let matrix_float_scal_mult = fun x (m:float array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- x *. row_input.(j)

    done ;

  done ;

  w ;;




(** 
matrix_float_scal_left_sub coefficient matrix
 *)


let matrix_float_scal_left_sub = fun x (m:float array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- row_input.(j) -. x

    done ;

  done ;

  w ;;




(** 
matrix_float_scal_right_sub coefficient matrix
 *)


let matrix_float_scal_right_sub = fun x (m:float array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- x -. row_input.(j)

    done ;

  done ;

  w ;;




(** 
matrix_float_scal_right_div coefficient matrix
 *)


let matrix_float_scal_right_div = fun x (m:float array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- x /. row_input.(j)

    done ;

  done ;

  w ;;




(** 
matrix_float_scal_left_div coefficient matrix
 *)


let matrix_float_scal_left_div = fun x (m:float array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- row_input.(j) /. x

    done ;

  done ;

  w ;;






(** 
matrix_float_plus matrix1 matrix2
 *)


let matrix_float_plus = fun (m:float array array) (mm:float array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_input_right = mm.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input_left) - 1 do

     row_output.(j) <- row_input_left.(j) +. row_input_right.(j)

    done ;

  done ;

  w ;;




(** 
matrix_float_minus matrix1 matrix2
 *)


let matrix_float_minus = fun (m:float array array) (mm:float array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_input_right = mm.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input_left) - 1 do

     row_output.(j) <- row_input_left.(j) -. row_input_right.(j)

    done ;

  done ;

  w ;;




(** 
matrix_float_coeff_prod matrix1 matrix2
 *)


let matrix_float_coeff_prod = fun (m:float array array) (mm:float array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_input_right = mm.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input_left) - 1 do

     row_output.(j) <- row_input_left.(j) *. row_input_right.(j)

    done ;

  done ;

  w ;;




(** 
matrix_float_coeff_div matrix1 matrix2
 *)


let matrix_float_coeff_div = fun (m:float array array) (mm:float array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_input_right = mm.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input_left) - 1 do

     row_output.(j) <- row_input_left.(j) /. row_input_right.(j)

    done ;

  done ;

  w ;;






(** 
matrix_float_twisted_prod matrix1 matrix2
 This calculates matrix1 times transpose ( matrix2 ).



Ceci calcule matrix1 fois transposée de matrix2. *)


let matrix_float_twisted_prod = fun (m:float array array) (mm:float array array) ->

 let r = Array.length m

 and c = Array.length mm

 and t = min ( Array.length m.(0) ) ( Array.length mm.(0) ) in

  let rr = r - 1

  and cc = c - 1

  and tt = t - 1

  and w = Array.make_matrix r c 0. in

   for i = 0 to rr do

   let row_input_left = m.(i)

   and row_output = w.(i) in

    for j = 0 to cc do

     let row_input_right = mm.(j)

     and coeff = ref row_output.(j) in

      for k = 0 to tt do

       coeff := !coeff +. row_input_left.(k) *. row_input_right.(k)

      done ;

      row_output.(j) <- !coeff

    done ;

   done ;

   w ;;




(** 
matrix_float_prod matrix1 matrix2
 *)


let matrix_float_prod = fun (m:float array array) (mm:float array array) ->

 matrix_float_twisted_prod m ( float_transpose mm ) ;;




(** 
matrix_float_triple_prod matrix1 matrix2
 *)


let matrix_float_triple_prod = fun (a:float array array) (b:float array array) (c:float array array)->

 matrix_float_twisted_prod a ( matrix_float_twisted_prod ( float_transpose c ) b ) ;;




(** 
matrix_float_naive_prod matrix1 matrix2
 *)


let matrix_float_naive_prod = fun (m:float array array) (mm:float array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length mm.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_output) - 1 do

     for k = 0 to (Array.length mm) - 1 do

      row_output.(j) <- row_input_left.(k) *. mm.(k).(j) +. row_output.(j)

     done

    done ;

  done ;

  w ;;






(** 
matrix_float_twisted_commut matrix1 matrix2
 *)


let matrix_float_twisted_commut = fun (m:float array array) (mm:float array array) ->

 matrix_float_minus ( matrix_float_twisted_prod m mm ) ( matrix_float_twisted_prod mm m ) ;;




(** 
matrix_float_twisted_commut_bis matrix1 matrix2
 *)


let matrix_float_twisted_commut_bis = fun (m:float array array) (mm:float array array) ->

 let m_m = float_transpose m

 and m_mm = float_transpose mm in

  matrix_float_minus ( matrix_float_twisted_prod m mm ) ( matrix_float_twisted_prod m_mm m_m ) ;;




(** 
matrix_float_commut matrix1 matrix2
 *)


let matrix_float_commut = fun (m:float array array) (mm:float array array) ->

 matrix_float_minus ( matrix_float_prod m mm ) ( matrix_float_prod mm m ) ;;






(** 
vector_matrix_float_prod vector matrix
 *)


let vector_matrix_float_prod = fun (v:float array) (m:float array array) ->

 let w = Array.make (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m.(0)) - 1 do

   let row_input = m.(i)

   and output = ref w.(i) in

    for j = 0 to (Array.length m) - 1 do

     output := row_input.(j) *. v.(j) +. !output

    done ;

    w.(i) <- !output ;

  done ;

  w ;;




(** 
matrix_vector_float_prod matrix vector
 *)


let matrix_vector_float_prod = fun (m:float array array) (v:float array) ->

 let w = Array.make (Array.length m) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and output = ref w.(i) in

    for j = 0 to (Array.length v) - 1 do

     output := row_input.(j) *. v.(j) +. !output

    done ;

    w.(i) <- !output ;

  done ;

  w ;;




(** 
vector_matrix_float_apply function vector matrix
 *)


let vector_matrix_float_apply = fun (f:float -> float -> float) (v:float array) (m:float array array) ->

 let l = Array.length m

 and c = Array.length m.(0) in

  let cc = c - 1

  and w = Array.make_matrix l c 0. in

   for i = 0 to l - 1 do

    let row_input = m.(i)

    and row_output = w.(i) in

    for j = 0 to cc do

     row_output.(j) <- f v.(j) row_input.(j)

    done ;

   done ;

   w ;;




(** 
vector_float_apply2 function vector vector
 *)


let vector_float_apply2 = fun (f:float -> float -> float) (u:float array) (v:float array) ->

 let l = Array.length u in

  let w = Array.make l 0. in

   for i = 0 to l - 1 do

    w.(i) <- f u.(i) v.(i)

   done ;

   w ;;




(** 
matrix_float_apply2 function matrix matrix
 *)


let matrix_float_apply2 = fun (f:float -> float -> float) (m:float array array) (w:float array array) ->

 let r = Array.length m

 and cc = Array.length m.(0) - 1 in

  let mm = Array.make_matrix r (Array.length m.(0)) 0. in

   for i = 0 to (Array.length m) - 1 do

    let row_input_left = m.(i)

    and row_input_right = w.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do

      row_output.(j) <- f row_input_left.(j) row_input_right.(j)

     done

    done ;

    mm ;;




(** 
matrix_vector_float_row_apply function vector matrix
 *)


let matrix_vector_float_row_apply = fun (f:float -> float -> float) (m:float array array) (v:float array) ->

 let l = Array.length m

 and c = Array.length m.(0) in

  let cc = c - 1

  and w = Array.make_matrix l c 0. in

   for i = 0 to l - 1 do

    let row_input = m.(i)

    and row_output = w.(i) in

     for j = 0 to cc do

      row_output.(j) <- f row_input.(j) v.(j)

     done ;

   done ;

   w ;;




(** 
matrix_float_row_apply_scal function matrix
 *)


let matrix_float_row_apply_scal = fun (f:float array -> float) (m:float array array) ->

 let l = Array.length m in

  let w = Array.make l 0. in

   for i = 0 to l - 1 do

    let row_input = m.(i) in

     w.(i) <- f row_input

   done ;

   w ;;




(** 
matrix_float_column_apply_scal function matrix
 *)


let matrix_float_column_apply_scal = fun (f:float array -> float) (m:float array array) ->

 matrix_float_row_apply_scal f ( float_transpose m ) ;;




(** 
matrix_float_row_apply_vect function matrix
 *)


let matrix_float_row_apply_vect = fun (f:float array -> float array) (m:float array array) ->

 let l = Array.length m in

  let w = Array.make l ( f m.(0) ) in

   for i = 0 to l - 1 do

    let row_input = m.(i) in

     w.(i) <- f row_input

   done ;

   w ;;




(** 
matrix_float_column_apply_vect function matrix
 *)


let matrix_float_column_apply_vect = fun (f:float array -> float array) (m:float array array) ->

 float_transpose ( matrix_float_row_apply_vect f ( float_transpose m ) ) ;;






(** 
float_sym matrix
 *)


let float_sym = function (m:float array array) ->

 matrix_float_scal_mult 0.5 ( matrix_float_plus (float_transpose m) m ) ;;




(** 
float_antisym matrix
 *)


let float_antisym = function (m:float array array) ->

 matrix_float_scal_mult 0.5 ( matrix_float_minus m (float_transpose m) ) ;;






(** 
vector_float_mean vector
 *)


let vector_float_mean = function (v:float array) ->

 ( vector_float_sum v ) /. ( float (Array.length v) ) ;;




(** 
vector_float_median vector
 *)


let vector_float_median = function (v:float array) ->

 let vv = List.fast_sort compare (Array.to_list v) in

  let l = List.length vv in

   let ll = l / 2 in

    if l mod 2 = 1 then List.nth vv ll

    else ( let a = List.nth vv ll and b = List.nth vv (ll - 1 ) in ( a +. b ) /. 2. ) ;;




(** 
matrix_float_median matrix
 *)


let matrix_float_median = function (m:float array array) ->

 vector_float_median ( inline m ) ;;




(** 
matrix_float_median_by_row matrix
 *)


let matrix_float_median_by_row = function (m:float array array) ->

 Array.map vector_float_median m ;;




(** 
matrix_float_median_by_column matrix
 *)


let matrix_float_median_by_column = function (m:float array array) ->

 matrix_float_median_by_row ( float_transpose m ) ;;




(** 
matrix_float_composed_median matrix
 *)


let matrix_float_composed_median = function (m:float array array) ->

 vector_float_median ( matrix_float_median_by_row m ) ;;




(** 
matrix_float_mean_median matrix
 *)


let matrix_float_mean_median = function (m:float array array) ->

 vector_float_mean ( matrix_float_median_by_row m ) ;;






(** 
float_eliminate vector_array
 *)


let float_eliminate = fun (v:float array array) ->

 let s = Array.length v.(0)

 and w = float_transpose v

 and condition = fun b z -> b || ( classify_float z ) = FP_infinite || ( classify_float z ) = FP_nan in

  let x = ref [| |] in

   for i = 0 to pred s do

    if not ( Array.fold_left condition false w.(i) ) then

     x := Array.append !x [| w.(i) |]

   done ;

   float_transpose !x ;;




(** 
vector_float_var vector
 *)


let vector_float_var = function (v:float array) ->

 let accu = ref 0.

 and accumul = ref 0. in

  for i = 0 to (Array.length v) - 1 do

   accu := v.(i) +. !accu ;

   accumul := v.(i) *. v.(i) +. !accumul

  done ;

  let q = ( float (Array.length v) ) in

   ( !accumul -. !accu *. !accu /. q ) /. q ;;




(** 
vector_float_stdev vector
 *)


let vector_float_stdev = function (v:float array) ->

 sqrt ( vector_float_var v ) ;;




(** 
vector_float_covar vector1 vector2
 *)


let vector_float_covar = fun (v:float array) (vv:float array) ->

 let accu = ref 0.

 and accum = ref 0.

 and accumul = ref 0. in

  for i = 0 to (Array.length v) - 1 do

   accu := v.(i) +. !accu ;

   accum := vv.(i) +. !accum ;

   accumul := v.(i) *. vv.(i) +. !accumul

  done ;

  let q = ( float (Array.length v) ) in

   ( !accumul -. !accu *. !accum /. q ) /. q ;;




(** 
vector_float_linear_regression vector1 vector2
 *)


let vector_float_linear_regression = fun (v:float array) (w:float array) ->

 let accuV = ref 0.

 and accuW = ref 0.

 and accuV2 = ref 0.

 and accuW2 = ref 0.

 and accuVW = ref 0. in

  for i = 0 to (Array.length v) - 1 do

   accuV := v.(i) +. !accuV ;

   accuV2 := v.(i) *. v.(i) +. !accuV2 ;

   accuVW := v.(i) *. w.(i) +. !accuVW ;

   accuW := w.(i) +. !accuW ;

   accuW2 := w.(i) *. w.(i) +. !accuW2 ;

  done ;

  let q = ( float (Array.length v) ) in

   let vbar = !accuV /. q

   and varv = ( !accuV2 -. !accuV *. !accuV /. q ) /. q

   and wbar = !accuW /. q

   and varw = ( !accuW2 -. !accuW *. !accuW /. q ) /. q

   and covar = ( !accuVW -. !accuV *. !accuW /. q ) /. q in

     let a = covar /. varv in

      let b = wbar -. a *. vbar

      and rho = covar /. sqrt ( varv *. varw ) in

       [| a ; b ; rho |] ;;




(** 
vector_float_norm_inf vector
 *)


let vector_float_norm_inf = function (v:float array) ->

 let accu = ref (-. max_float) in

  for i = 0 to (Array.length v) - 1 do

   accu := max ( abs_float v.(i) ) !accu

  done ;

  !accu ;;




(** 
vector_float_norm_1 vector
 *)


let vector_float_norm_1 = function (v:float array) ->

 let accu = ref 0. in

  for i = 0 to (Array.length v) - 1 do

   accu := ( abs_float v.(i) ) +. !accu

  done ;

  !accu ;;




(** 
vector_float_norm_2 vector
 *)


let vector_float_norm_2 = function (v:float array) ->

 let accu = ref 0. in

  for i = 0 to (Array.length v) - 1 do

   accu := v.(i) *. v.(i) +. !accu

  done ;

  sqrt ( !accu ) ;;




(** 
vector_float_square_norm_2 vector
 *)


let vector_float_square_norm_2 = function (v:float array) ->

 let accu = ref 0. in

  for i = 0 to (Array.length v) - 1 do

   accu := v.(i) *. v.(i) +. !accu

  done ;

  !accu ;;




(** 
vector_float_norm exponent vector
 *)


let vector_float_norm = fun a (v:float array) ->

 let accu = ref 0. in

  for i = 0 to (Array.length v) - 1 do

   accu :=  exp ( a *. log ( abs_float v.(i) ) ) +. !accu

  done ;

  exp ( log ( !accu ) /. a ) ;;






(** 
matrix_float_norm_inf matrix
 *)


let matrix_float_norm_inf = function (m:float array array) ->

 let accu = ref (-. max_float) in

  for i = 0 to (Array.length m) - 1 do

   let accumul = ref 0.

   and row_input = m.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     accumul := ( abs_float row_input.(j) ) +. !accumul

    done ;

    accu := max !accumul !accu

  done ;

  !accu ;;




(** 
matrix_float_norm_1 matrix
 *)


let matrix_float_norm_1 = function (m:float array array) ->

 matrix_float_norm_inf ( float_transpose m ) ;;




(** 
matrix_float_norm_frobenius matrix
 *)


let matrix_float_norm_frobenius = function (m:float array array) ->

 let accu = ref 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     accu := ( row_input.(j) *. row_input.(j) ) +. !accu

    done ;

  done ;

  sqrt !accu ;;




(** 
matrix_float_square_frobenius matrix
 *)


let matrix_float_square_frobenius = function (m:float array array) ->

 let accu = ref 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     accu := ( row_input.(j) *. row_input.(j) ) +. !accu

    done ;

  done ;

  !accu ;;




(** 
matrix_float_frobenius_prod matrix
 *)


let matrix_float_frobenius_prod = fun (m:float array array) (p:float array array) ->

 let accu = ref 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_input_right = p.(i)  in

    for j = 0 to (Array.length row_input_left) - 1 do

     accu := ( row_input_left.(j) *. row_input_right.(j) ) +. !accu

    done ;

  done ;

  !accu ;;




(** 
matrix_float_norm_1_approx matrix
 *)


let matrix_float_norm_1_approx = function (m:float array array) ->

 let accu = ref (-. max_float)

 and mm = matrix_float_bal_random (Array.length m.(0)) ( Util.int_max 100 ( Util.int_max (Array.length m.(0)) (Array.length m) ) ) 1. in

  let mmm = matrix_float_prod m mm in

  for i = 0 to (Array.length mmm.(0)) - 1 do

   let col_input = extract_column i mm

   and col_output = extract_column i mmm in

    let a = vector_float_norm_1 col_input

    and b = vector_float_norm_1 col_output in

     accu := max ( b /. a ) !accu

  done ;

  !accu ;;




(** 
matrix_float_norm_2_approx matrix
 *)


let matrix_float_norm_2_approx = function (m:float array array) ->

 let accu = ref (-. max_float)

 and mm = matrix_float_bal_random (Array.length m.(0)) ( Util.int_max 100 ( Util.int_max (Array.length m.(0)) (Array.length m) ) ) 1. in

  let mmm = matrix_float_prod m mm in

  for i = 0 to (Array.length mmm.(0)) - 1 do

   let col_input = extract_column i mm

   and col_output = extract_column i mmm in

    let a = vector_float_norm_2 col_input

    and b = vector_float_norm_2 col_output in

     accu := max ( b /. a ) !accu

  done ;

  !accu ;;




(** 
matrix_float_norm_approx exponent matrix
 *)


let matrix_float_norm_approx = fun alpha (m:float array array) ->

 let accu = ref (-. max_float)

 and mm = matrix_float_bal_random (Array.length m.(0)) ( Util.int_max 100 ( Util.int_max (Array.length m.(0)) (Array.length m) ) ) 1. in

  let mmm = matrix_float_prod m mm in

  for i = 0 to (Array.length mmm.(0)) - 1 do

   let col_input = extract_column i mm

   and col_output = extract_column i mmm in

    let a = vector_float_norm alpha col_input

    and b = vector_float_norm alpha col_output in

     accu := max ( b /. a ) !accu

  done ;

  !accu ;;






(** 
matrix_float_non_diag_part norm matrix
 *)


let matrix_float_non_diag_part = function (m:float array array) ->

let w = matrix_float_copy m in

 for i = 0 to ( Array.length m ) - 1 do

  w.(i).(i) <- 0. ;

 done ;

 w ;;




(** 
matrix_float_non_diagonality norm matrix
 *)


let matrix_float_non_diagonality = fun (distance:float array array -> float) (m:float array array) ->

 let mm = matrix_float_non_diag_part m in

  distance mm ;;




(** 
matrix_float_non_scal_part norm matrix
 *)


let matrix_float_non_scal_part = function (m:float array array) ->

 let rr = float (Array.length m) in

  matrix_float_scal_left_sub ( (float_trace m) /. rr ) m ;;




(** 
matrix_float_non_scalarity norm matrix
 *)


let matrix_float_non_scalarity = fun (distance:float array array -> float) (m:float array array) ->

 let mm = matrix_float_non_scal_part m in

  distance mm ;;










(** 
§ 
 *)



(** 

Calcul élémentaire sur les matrices entières


Elementary calculus for integer matrices

*)



(** 
 
 *)











(** 
vector_int_copy vector
 *)


let vector_int_copy = function (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- v.(i)

   done ;

   vv ;;




(** 
vector_int_clip vector
 *)


let vector_int_clip = fun (x:int) (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- min x v.(i)

   done ;

   vv ;;




(** 
vector_int_crest integer vector
 *)


let vector_int_crest = fun (x:int) (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    let y = v.(i) in

     if y > x then

      vv.(i) <- y - x

   done ;

   vv ;;




(** 
vector_int_gully integer vector
 *)


let vector_int_gully = fun (x:int) (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    let y = v.(i) in

     if y < x then

      vv.(i) <- x - y

   done ;

   vv ;;






(** 
other_vector_int_copy vector
 *)


let other_vector_int_copy = function (v:int array) ->

  let vv = Array.make (Array.length v) 0 in

   for i = 0 to (Array.length v) - 1 do

    vv.(i) <- v.(i)

   done ;

   vv ;;




(** 
matrix_int_copy vector
 *)


let matrix_int_copy = function (m:int array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do    

     row_output.(j) <- row_input.(j)

    done

  done ;

  mm ;;




(** 
matrix_int_clip vector
 *)


let matrix_int_clip = fun (x:int) (m:int array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do    

     row_output.(j) <- min x row_input.(j)

    done

  done ;

  mm ;;




(** 
matrix_int_crest integer vector
 *)


let matrix_int_crest = fun (x:int) (m:int array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     let y = row_input.(j) in

      if y > x then

       row_output.(j) <- y - x

    done

  done ;

  mm ;;




(** 
matrix_int_gully integer vector
 *)


let matrix_int_gully = fun (x:int) (m:int array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     let y = row_input.(j) in

      if y < x then

       row_output.(j) <- x - y

    done

  done ;

  mm ;;






(** 
int_sub_matrix matrix beg-row end-row beg-col end-col
 *)


let int_sub_matrix = fun (m:int array array) i ii j jj ->


(** i et j : beginning: début ; ii et jj : end: fin *)


 let mm = Array.make_matrix (ii - i + 1) (jj - j + 1) 0 in

  for index = i to ii do

   let row_input = m.(index)

   and row_output = mm.(index - i) in

    for indice = j to jj do

     row_output.(indice - j) <- row_input.(indice)

    done

  done ;

 mm ;;




(** 
float_of_vector vector
 *)


let float_of_vector = function (v:int array) ->

 let vv = Array.make (Array.length v) 0. in

  for i = 0 to (Array.length v) - 1 do

   vv.(i) <- float_of_int v.(i)

  done ;

  vv ;;




(** 
float_of_matrix matrix
 *)


let float_of_matrix = function (m:int array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0. in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do    

     row_output.(j) <- float_of_int row_input.(j)

    done

  done ;

  mm ;;






(** 
int_transpose matrix
 *)


let int_transpose = function (m:int array array) ->

 let mm = Array.make_matrix (Array.length m.(0)) (Array.length m) 0 in

   for i = 0 to (Array.length m - 1) do

    let row_input = m.(i) in

    for j = 0 to (Array.length row_input - 1) do

     mm.(j).(i) <- row_input.(j)

    done

   done ;  

  mm;;






(** 
vector_int_max vector
 *)


let vector_int_max = function (v:int array) ->

 let accu = ref v.(0) in

  for i = 0 to (Array.length v) - 1 do

   accu := Util.int_max v.(i) !accu

  done ;

  !accu ;;






(** 
matrix_int_max_by_row matrix
 matrix_int_max_by_row even for lacunar matrices:



matrix_int_max_by_row fonctionne même pour les matrices lacunaires. *)


let matrix_int_max_by_row = function (m:int array array) ->

 let accu = Array.make (Array.length m) (- max_int) in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i)

   and accumul = ref accu.(i) in

    for j = 0 to (Array.length row) - 1 do

     accumul := Util.int_max row.(j) !accumul

    done ;

    accu.(i) <- !accumul

  done ;

  accu ;;




(** 
matrix_int_max_by_column matrix
 *)


let matrix_int_max_by_column = function (m:int array array) ->

 let cc = (numcolumns m) - 1 in

  let accu = Array.make (cc + 1) (- max_int) in

   for j = 0 to cc do

    let accumul = ref accu.(j) in

     for i = 0 to ( (Array.length m) - 1 ) do

      accumul := Util.int_max m.(i).(j) !accumul

     done ;

     accu.(j) <- !accumul

   done ;

  accu ;;




(** 
matrix_int_max matrix
 *)


let matrix_int_max = function (m:int array array) ->

 let accu = ref (- max_int) in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i) in

    for j = 0 to (Array.length row) - 1 do

     accu := Util.int_max row.(j) !accu

    done

  done ;

  !accu ;;






(** 
vector_int_min vector
 *)


let vector_int_min = function (v:int array) ->

 let accu = ref v.(0) in

  for i = 0 to (Array.length v) - 1 do

   accu := min v.(i) !accu

  done ;

  !accu ;;






(** 
matrix_int_min_by_row matrix
 matrix_int_min_by_row even for lacunar matrices:



matrix_int_min_by_row fonctionne même pour les matrices lacunaires. *)


let matrix_int_min_by_row = function (m:int array array) ->

 let accu = Array.make (Array.length m) (- min_int) in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i)

   and accumul = ref accu.(i) in

    for j = 0 to (Array.length row) - 1 do

     accumul := min row.(j) !accumul

    done ;

    accu.(i) <- !accumul

  done ;

  accu ;;




(** 
matrix_int_min_by_column matrix
 *)


let matrix_int_min_by_column = function (m:int array array) ->

 let cc = (numcolumns m) - 1 in

  let accu = Array.make (cc + 1) (- min_int) in

   for j = 0 to cc do

    let accumul = ref accu.(j) in

     for i = 0 to ( (Array.length m) - 1 ) do

      accumul := min m.(i).(j) !accumul

     done ;

     accu.(j) <- !accumul

   done ;

  accu ;;




(** 
matrix_int_min matrix
 *)


let matrix_int_min = function (m:int array array) ->

 let accu = ref (- min_int) in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i) in

    for j = 0 to (Array.length row) - 1 do

     accu := min row.(j) !accu

    done

  done ;

  !accu ;;






(** 
vector_int_find_last element vector
 vector_int_find_last returns -1 if it does not find:



vector_int_find_last retourne -1 s'il ne trouve pas. *)


let vector_int_find_last = fun x (v:int array) ->

 let index = ref (-1) in

  let i = ref ( (Array.length v) - 1 ) in

   while  !i >= 0 do

    if x = v.(!i) then (index := !i ; i := -1) else i := !i - 1 ; 

   done ;

   !index ;;






(** 
vector_int_find_first element vector
 vector_int_find_first returns -1 if it does not find:



vector_int_find_first retourne -1 s'il ne trouve pas. *)


let vector_int_find_first = fun x (v:int array) ->

 let index = ref (-1)

 and i = ref 0 in

  while  !i < Array.length v do

   if x = v.(!i) then (index := !i ; i := Array.length v ) else i := !i + 1 ; 

  done ;

 !index ;;






(** 
vector_int_find_twin element vector
 vector_int_find_first returns -1 if it does not find:



vector_int_find_twin retourne -1 s'il ne trouve pas. *)


let vector_int_find_twin = fun x (v:int array) ->

 let index = ref (-1)

 and i = ref 0 in

  while  !i <= min ((Array.length v) - 1) ( int_of_float ( ceil ( (float (Array.length v)) /. 2. ) ) )  do

   if x = v.(!i) then (index := !i ; i := 1 + Array.length v )

   else

    begin

     let j = (Array.length v) - 1 - !i in

     if x = v.(j) then ( index := j ; i := 1 + Array.length v ) else i := !i + 1 ; 

    end

  done ;

 !index ;;






(** 
vector_int_find_all element vector
 vector_int_find_all returns [||]  if it does not find:



vector_int_find_all retourne [||] s'il ne trouve pas.*)


let vector_int_find_all = fun x (v:int array) ->

 let index = ref [||] in

  for i = 0 to (Array.length v) - 1 do

   if (x = v.(i)) then (index := Array.append !index [|i|] ; ())

  done ;

 !index ;;






(** 
matrix_int_find_last element vector
 matrix_int_find_last returns [|-1;-1|] if it does not find:



matrix_int_find_last retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_int_find_last = fun x (m:int array array) ->

 let index = ref (-1) and indice = ref (-1) in

  let i = ref ( (Array.length m) - 1 ) in

   while  !i >= 0 do

    let row = m.(!i) in

     let j = ref ( (Array.length row) - 1 ) in

      while  !j >= 0 do

       if x = row.(!j) then (indice := !j ; j := -1) else j := !j - 1 ; 

      done ;

      if !indice <> -1 then (index := !i ; i := -1) else i := !i - 1 ;

   done ;

   [| !index ; !indice |] ;;






(** 
matrix_int_find_first element vector
 matrix_find_first returns [|-1;-1|] if it does not find:



matrix_int_find_first retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_int_find_first = fun x (m:int array array) ->

 let index = ref (-1) and indice = ref (-1) in

  let i = ref 0 in

   while  !i < Array.length m do

    let row = m.(!i) in

     let j = ref 0 in

      while  !j < Array.length row do

       if x = row.(!j) then ( indice := !j ; j := Array.length row ) else j := !j + 1 ; 

      done ;

      if !indice <> -1 then ( index := !i ; i := Array.length m ) else i := !i + 1 ;

   done ;

   [| !index ; !indice |] ;;






(** 
matrix_int_find_twin element vector
 matrix_find_twin returns [|-1;-1|] if it does not find:



matrix_int_find_twin retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_int_find_twin = fun x (m:int array array) ->

 let index = ref (-1) and indice = ref (-1) in

  let i = ref 0 in

   while  !i <= min (Array.length m - 1) ( int_of_float ( ceil ( (float (Array.length m)) /. 2. ) ) ) do

    let row = m.(!i) in

     let j = ref 0 in

      while  !j <= min (Array.length row - 1) ( int_of_float ( ceil ( (float (Array.length row)) /. 2. ) ) ) do

       if x = row.(!j) then ( indice := !j ; j := 1 + Array.length row )

       else

        begin

         let k = (Array.length row) - 1 - !j in

         if x = row.(k) then ( indice := k ; j := 1 + Array.length row ) else j := !j + 1 ; 

        end

      done ;

      if !indice <> -1 then ( index := !i ; i := 1 + Array.length m ) else i := !i + 1 ;

   done ;

   [| !index ; !indice |] ;;






(** 
matrix_int_find_all element vector
 matrix_find_all returns [|-1;-1|] if it does not find:



matrix_int_find_all retourne [|-1;-1|] s'il ne trouve pas. *)


let matrix_int_find_all = fun x (m:int array array) ->

 let result = ref [||] and index = ref [||] and indice = ref [||] in

  for i = 0 to Array.length m - 1 do

   let row = m.(i) in

    for j = 0 to Array.length row -1 do

     if x = row.(j) then ( indice := Array.append !indice [|j|] ; () )

    done ;

    if !indice <> [||] then 

     begin

      index := Array.map (function a -> [| i ; a|]) !indice ; 

      result := Array.append !result !index 

     end

  done ;

  !result ;;






(** 
vector_int_sum vector
 *)


let vector_int_sum = function (v:int array) ->

 let accu = ref 0 in

  for i = 0 to (Array.length v) - 1 do

   accu := v.(i) + !accu

  done ;

  !accu ;;




(** 
vector_int_contraction vector
 *)


let vector_int_contraction = function (v:int array) ->

 let accu = ref 1 in

  for i = 0 to (Array.length v) - 1 do

   accu := v.(i) * !accu

  done ;

  !accu ;;




(** 
matrix_int_sum_by_row matrix
 *)


let matrix_int_sum_by_row = function (m:int array array) ->

 let accu = Array.make (Array.length m) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i)

   and accumul = ref accu.(i) in

    for j = 0 to (Array.length row) - 1 do

     accumul := row.(j) + !accumul

    done ;

    accu.(i) <- !accumul

  done ;

  accu ;;




(** 
matrix_int_sum_by_column matrix
 *)


let matrix_int_sum_by_column = function (m:int array array) ->

 let cc = (numcolumns m) - 1 in

  let accu = Array.make (cc + 1) 0 in

   for j = 0 to cc do

    let accumul = ref accu.(j) in

     for i = 0 to ( (Array.length m) - 1 ) do

      accumul := m.(i).(j) + !accumul

     done ;

     accu.(j) <- !accumul

   done ;

  accu ;;




(** 
matrix_int_sum matrix
 *)


let matrix_int_sum = function (m:int array array) ->

 let accu = ref 0 in

  for i = 0 to (Array.length m) - 1 do

   let row = m.(i) in

    for j = 0 to (Array.length row) - 1 do

     accu := row.(j) + !accu

    done

  done ;

  !accu ;;






(** 
vector_int_abs vector
 *)


let vector_int_abs = function (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- abs v.(i)

   done ;

   vv ;;




(** 
matrix_int_abs matrix
 *)


let matrix_int_abs = function (m:int array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do    

     row_output.(j) <- abs row_input.(j)

    done

  done ;

  mm ;;




(** 
matrix_int_opp matrix
 *)


let matrix_int_opp = function (m:int array array) ->

 let mm = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = mm.(i) in

    for j = 0 to (Array.length row_input) - 1 do    

     row_output.(j) <- - row_input.(j)

    done

  done ;

  mm ;;






(** 
string_of_vector_int vector
 *)


let string_of_vector_int = function (v:int array) ->

 let rr = Array.length v - 1

 and s = ref "[| " in

  for i = 0 to ( rr - 1 ) do

   s := !s ^ ( string_of_int v.(i) ) ^ " ; " 

  done ;

  s := !s ^ ( string_of_int v.(rr) ) ^ " |]" ;

  !s ;;




(** 
vector_int_print vector
 *)


let vector_int_print = function (v:int array) ->

 let s = string_of_vector_int v in

 print_string s ;

 print_newline () ;;




(** 
bare_vector_int_to_string vector
 *)


let bare_vector_int_to_string = function (v:int array) ->

 let r = Array.length v

  and s = ref "[|" in

  for i = 0 to ( r - 2 ) do

   s := !s ^ ( string_of_int v.(i) ) ^ " " 

  done ;

  s := !s ^ ( string_of_int v.(r - 1) ) ^ "|]" ;

  !s ;;




(** 
bare_vector_int_print vector
 *)


let bare_vector_int_print = function (v:int array) ->

 let s = bare_vector_int_to_string v in

  print_string s ;;






(** 
vector_int_of_string string
 *)


let vector_int_of_string = function (s:string) ->

 let ls = String.length s in

  let st = String.sub s 3 ( ls - 6 ) in

   let listing = Str.split ( Str.regexp " ; " ) st in

    let a = Array.of_list listing in

     Array.map int_of_string a ;;




(** 
bare_vector_int_of_string string
 *)


let bare_vector_int_of_string = function (s:string) ->

 let ls = String.length s in

  let st = String.sub s 2 ( ls - 4 ) in

   let listing = Str.split ( Str.regexp " " ) st in

    let a = Array.of_list listing in

     Array.map int_of_string a ;;






(** 
matrix_int_to_string matrix
 *)


let matrix_int_to_string = function (m:int array array) ->

 let s = ref "[| with "

 and r = Array.length m

 and c = slow_numcolumns m in

  s := !s ^ string_of_int r ;

  if r > 1 then s := !s ^ " rows"

  else s := !s ^ " row" ;

  s := !s ^ "\n" ;

  s := !s ^ bare_vector_int_to_string m.(0) ^ " ;" ; 

  for i = 1 to ( Array.length m - 1 ) do

   begin

    s := !s ^ "\n" ^ ( bare_vector_int_to_string m.(i) ) ^ " ;"

   end

  done ;

  s := !s ^ "\n|] and " ^ ( string_of_int c ) ;

  if c > 1 then s := !s ^ " columns\n"

  else s := !s ^ " column\n" ;

  !s ;;






(** 
matrix_int_print matrix
 *)


let matrix_int_print = function (m:int array array) ->

 let s = matrix_int_to_string m in

  print_string s ;;






(** 
matrix_int_of_string string
 *)


let matrix_int_of_string = function (s:string) ->

 let ls = String.length s in

  let st = String.sub s 8 ( ls - 8 ) in

   let number_of_rows = 

    begin

     let position = Str.search_forward ( Str.regexp " row" ) st 0 in

      int_of_string ( String.sub st 0 position )

    end in

    let m = Array.make_matrix number_of_rows 0 0

    and listing = Str.split ( Str.regexp " ;\n" ) s in

     let a = Array.sub ( Array.of_list listing ) 0 number_of_rows in

      for i = 1 to pred number_of_rows do

       m.(i) <- bare_vector_int_of_string a.(i)

      done ;

      let str = List.hd ( List.tl ( Str.split ( Str.regexp "\n" ) a.(0) ) ) in

       m.(0) <- bare_vector_int_of_string str ;

       m ;;






(** 
int_trace matrix
 *)


let int_trace = function (m:int array array) ->

 let r = min (Array.length m) (Array.length m.(0))

 and accumulateur = ref 0 in

  if r > 0 then 

   for i = 0 to r - 1 do

    accumulateur := !accumulateur + m.(i).(i)

   done ;

  !accumulateur ;;






(** 
vector_int_scal_add coefficient vector
 *)


let vector_int_scal_add = fun (x:int) (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- x + v.(i)

   done ;

   vv ;;




(** 
vector_int_scal_mult coefficient vector
 *)


let vector_int_scal_mult = fun (x:int) (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- x * v.(i)

   done ;

   vv ;;




(** 
vector_int_scal_left_sub coefficient vector
 *)


let vector_int_scal_left_sub = fun (x:int) (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- v.(i) - x

   done ;

   vv ;;




(** 
vector_int_scal_right_sub coefficient vector
 *)


let vector_int_scal_right_sub = fun (x:int) (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- x - v.(i)

   done ;

   vv ;;




(** 
vector_int_scal_left_div coefficient vector
 *)


let vector_int_scal_left_div = fun (x:int) (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- v.(i) / x

   done ;

   vv ;;




(** 
vector_int_scal_right_div coefficient vector
 *)


let vector_int_scal_right_div = fun (x:int) (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- x / v.(i)

   done ;

   vv ;;




(** 
vector_int_scal_left_mod coefficient vector
 *)


let vector_int_scal_left_mod = fun (x:int) (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- x mod v.(i)

   done ;

   vv ;;




(** 
vector_int_scal_right_mod coefficient vector
 *)


let vector_int_scal_right_mod = fun (x:int) (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- v.(i) mod x

   done ;

   vv ;;




(** 
vector_int_opp vector
 *)


let vector_int_opp = fun (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    vv.(i) <- - v.(i)

   done ;

   vv ;;




(** 
vector_int_inv vector
 *)


let vector_int_inv = fun (v:int array) ->

 let r = Array.length v in

  let vv = Array.make r 0 in

   for i = 0 to r - 1 do

    begin

     let x = v.(i) in

      if x == 0 then failwith "Division by zero in Matrix.vector_int_inv." ;

      vv.(i) <- 1 / x

    end

   done ;

   vv ;;






(** 
vector_int_plus vector1 vector2
 *)


let vector_int_plus = fun (v:int array) (vv:int array) ->

 let r = Array.length v in

  let vvv = Array.make r 0 in

   for i = 0 to r - 1 do

    vvv.(i) <- v.(i) + vv.(i)

   done ;

   vvv ;;




(** 
vector_int_minus vector1 vector2
 *)


let vector_int_minus = fun (v:int array) (vv:int array) ->

 let r = Array.length v in

  let vvv = Array.make r 0 in

   for i = 0 to r - 1 do

    vvv.(i) <- v.(i) - vv.(i)

   done ;

   vvv ;;




(** 
vector_int_coeff_prod vector1 vector2
 *)


let vector_int_coeff_prod = fun (v:int array) (vv:int array) ->

 let r = Array.length v in

  let vvv = Array.make r 0 in

   for i = 0 to r - 1 do

    vvv.(i) <- v.(i) * vv.(i)

   done ;

   vvv ;;




(** 
vector_int_coeff_div vector1 vector2
 *)


let vector_int_coeff_div = fun (v:int array) (vv:int array) ->

 let r = Array.length v in

  let vvv = Array.make r 0 in

   for i = 0 to r - 1 do

    vvv.(i) <- v.(i) / vv.(i)

   done ;

   vvv ;;




(** 
vector_int_coeff_mod vector1 vector2
 *)


let vector_int_coeff_mod = fun (v:int array) (vv:int array) ->

 let r = Array.length v in

  let vvv = Array.make r 0 in

   for i = 0 to r - 1 do

    vvv.(i) <- v.(i) mod vv.(i)

   done ;

   vvv ;;




(** 
vector_int_scal_prod vector1 vector2
 *)


let vector_int_scal_prod = fun (v:int array) (vv:int array) ->

 let x = ref 0 in

  for i = 0 to (Array.length v) - 1 do

   x := !x + v.(i) * vv.(i)

  done ; 

  !x ;;






(** 
partial_int_scal_add beginning end vector1 vector2
 *)


let partial_int_scal_add = fun i j x (v:int array) ->

 let w = Array.make (Array.length v) 0 in

  for k = i to j do

   w.(k) <- v.(k) + x

  done ;

  w ;;




(** 
part_int_scal_add beginning end vector1 vector2
 *)


let part_int_scal_add = fun i j x (v:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- v.(k) + x

   done ;

   w ;;




(** 
partial_int_scal_mult beginning end vector1 vector2
 *)


let partial_int_scal_mult = fun i j x (v:int array) ->

 let w = Array.make (Array.length v) 0 in

  for k = i to j do

   w.(k) <- v.(k) * x

  done ;

  w ;;




(** 
part_int_scal_mult beginning end vector1 vector2
 *)


let part_int_scal_mult = fun i j x (v:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- v.(k) * x

   done ;

   w ;;




(** 
partial_int_scal_left_sub beginning end vector1 vector2
 *)


let partial_int_scal_left_sub = fun i j x (v:int array) ->

 let w = Array.make (Array.length v) 0 in

  for k = i to j do

   w.(k) <- v.(k) - x

  done ;

  w ;;




(** 
part_int_scal_left_sub beginning end vector1 vector2
 *)


let part_int_scal_left_sub = fun i j x (v:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- v.(k) - x

   done ;

   w ;;




(** 
partial_int_scal_right_sub beginning end vector1 vector2
 *)


let partial_int_scal_right_sub = fun i j x (v:int array) ->

 let w = Array.make (Array.length v) 0 in

  for k = i to j do

   w.(k) <- x - v.(k)

  done ;

  w ;;




(** 
part_int_scal_right_sub beginning end vector1 vector2
 *)


let part_int_scal_right_sub = fun i j x (v:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- x - v.(k)

   done ;

   w ;;




(** 
partial_int_scal_left_div beginning end vector1 vector2
 *)


let partial_int_scal_left_div = fun i j x (v:int array) ->

 let w = Array.make (Array.length v) 0 in

  for k = i to j do

   w.(k) <- v.(k) / x

  done ;

  w ;;




(** 
part_int_scal_left_div beginning end vector1 vector2
 *)


let part_int_scal_left_div = fun i j x (v:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- v.(k) / x

   done ;

   w ;;




(** 
partial_int_scal_right_div beginning end vector1 vector2
 *)


let partial_int_scal_right_div = fun i j x (v:int array) ->

 let w = Array.make (Array.length v) 0 in

  for k = i to j do

   w.(k) <- x / v.(k)

  done ;

  w ;;




(** 
part_int_scal_right_div beginning end vector1 vector2
 *)


let part_int_scal_right_div = fun i j x (v:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- x / v.(k)

   done ;

   w ;;




(** 
partial_int_scal_left_mod beginning end vector1 vector2
 *)


let partial_int_scal_left_mod = fun i j x (v:int array) ->

 let w = Array.make (Array.length v) 0 in

  for k = i to j do

   w.(k) <- x mod v.(k)

  done ;

  w ;;




(** 
part_int_scal_left_mod beginning end vector1 vector2
 *)


let part_int_scal_left_mod = fun i j x (v:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- x mod v.(k)

   done ;

   w ;;




(** 
partial_int_scal_right_mod beginning end vector1 vector2
 *)


let partial_int_scal_right_mod = fun i j x (v:int array) ->

 let w = Array.make (Array.length v) 0 in

  for k = i to j do

   w.(k) <- v.(k) mod x

  done ;

  w ;;




(** 
part_int_scal_right_mod beginning end vector1 vector2
 *)


let part_int_scal_right_mod = fun i j x (v:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- v.(k) mod x

   done ;

   w ;;








(** 
partial_int_plus beginning end vector1 vector2
 *)


let partial_int_plus = fun i j (v:int array) (vv:int array) ->

 let c = min (Array.length v) (Array.length vv) in

  let w = Array.make c 0 in

   for k = i to j do

    w.(k) <- v.(k) + vv.(k)

   done ;

   w ;;




(** 
part_int_plus beginning end vector1 vector2
 *)


let part_int_plus = fun i j (v:int array) (vv:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- v.(k) + vv.(k)

   done ;

   w ;;




(** 
partial_int_minus beginning end vector1 vector2
 *)


let partial_int_minus = fun i j s t ->

 let c = min (Array.length s) (Array.length t) in

  let m = Array.make c 0 in

   for k = i to j do

    m.(k) <- s.(k) - t.(k)

   done ;

   m ;;




(** 
part_int_minus beginning end vector1 vector2
 *)


let part_int_minus = fun i j (v:int array) (vv:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- v.(k) - vv.(k)

   done ;

   w ;;




(** 
partial_int_coeff_prod beginning end vector1 vector2
 *)


let partial_int_coeff_prod = fun i j (v:int array) (vv:int array) ->

 let c = min (Array.length v) (Array.length vv) in

  let w = Array.make c 0 in

   for k = i to j do

    w.(k) <- v.(k) * vv.(k)

   done ;

   w ;;




(** 
part_int_coeff_prod beginning end vector1 vector2
 *)


let part_int_coeff_prod = fun i j (v:int array) (vv:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- v.(k) * vv.(k)

   done ;

   w ;;




(** 
partial_int_coeff_div beginning end vector1 vector2
 *)


let partial_int_coeff_div = fun i j (v:int array) (vv:int array) ->

 let c = min (Array.length v) (Array.length vv) in

  let w = Array.make c 0 in

   for k = i to j do

    w.(k) <- v.(k) / vv.(k)

   done ;

   w ;;




(** 
part_int_coeff_div beginning end vector1 vector2
 *)


let part_int_coeff_div = fun i j (v:int array) (vv:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- v.(k) / vv.(k)

   done ;

   w ;;




(** 
partial_int_coeff_mod beginning end vector1 vector2
 *)


let partial_int_coeff_mod = fun i j (v:int array) (vv:int array) ->

 let c = min (Array.length v) (Array.length vv) in

  let w = Array.make c 0 in

   for k = i to j do

    w.(k) <- v.(k) mod vv.(k)

   done ;

   w ;;




(** 
part_int_coeff_mod beginning end vector1 vector2
 *)


let part_int_coeff_mod = fun i j (v:int array) (vv:int array) ->

 let w = Array.make ( j - i + 1 ) 0 in

   for k = i to j do

    w.(k-i) <- v.(k) mod vv.(k)

   done ;

   w ;;






(** 
matrix_int_scal_add coefficient matrix
 *)


let matrix_int_scal_add = fun x (m:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = ref w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     !row_output.(j) <- x + row_input.(j)

    done ;

    w.(i) <- !row_output

  done ;

  w ;;




(** 
matrix_int_scal_mult coefficient matrix
 *)


let matrix_int_scal_mult = fun x (m:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = ref w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     !row_output.(j) <- x * row_input.(j)

    done ;

    w.(i) <- !row_output

  done ;

  w ;;




(** 
matrix_int_scal_left_sub coefficient matrix
 *)


let matrix_int_scal_left_sub = fun x (m:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- row_input.(j) - x

    done ;

  done ;

  w ;;




(** 
matrix_int_scal_right_sub coefficient matrix
 *)


let matrix_int_scal_right_sub = fun x (m:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- x - row_input.(j)

    done ;

  done ;

  w ;;




(** 
matrix_int_scal_left_div coefficient matrix
 *)


let matrix_int_scal_left_div = fun x (m:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- row_input.(j) / x

    done ;

  done ;

  w ;;




(** 
matrix_int_scal_right_div coefficient matrix
 *)


let matrix_int_scal_right_div = fun x (m:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- x / row_input.(j)

    done ;

  done ;

  w ;;




(** 
matrix_int_scal_left_mod coefficient matrix
 *)


let matrix_int_scal_left_mod = fun x (m:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- x mod row_input.(j)

    done ;

  done ;

  w ;;




(** 
matrix_int_scal_right_mod coefficient matrix
 *)


let matrix_int_scal_right_mod = fun x (m:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     row_output.(j) <- row_input.(j) mod x

    done ;

  done ;

  w ;;






(** 
matrix_int_plus matrix1 matrix2
 *)


let matrix_int_plus = fun (m:int array array) (mm:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_input_right = mm.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input_left) - 1 do

     row_output.(j) <- row_input_left.(j) + row_input_right.(j)

    done ;

  done ;

  w ;;




(** 
matrix_int_minus matrix1 matrix2
 *)


let matrix_int_minus = fun (m:int array array) (mm:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_input_right = mm.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input_left) - 1 do

     row_output.(j) <- row_input_left.(j) - row_input_right.(j)

    done ;

  done ;

  w ;;




(** 
matrix_int_coeff_prod matrix1 matrix2
 *)


let matrix_int_coeff_prod = fun (m:int array array) (mm:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_input_right = mm.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input_left) - 1 do

     row_output.(j) <- row_input_left.(j) * row_input_right.(j)

    done ;

  done ;

  w ;;




(** 
matrix_int_coeff_div matrix1 matrix2
 *)


let matrix_int_coeff_div = fun (m:int array array) (mm:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_input_right = mm.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input_left) - 1 do

     row_output.(j) <- row_input_left.(j) / row_input_right.(j)

    done ;

  done ;

  w ;;




(** 
matrix_int_coeff_mod matrix1 matrix2
 *)


let matrix_int_coeff_mod = fun (m:int array array) (mm:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_input_right = mm.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_input_left) - 1 do

     row_output.(j) <- row_input_left.(j) mod row_input_right.(j)

    done ;

  done ;

  w ;;






(** 
matrix_int_twisted_prod matrix1 matrix2
 This calculates matrix1 times transpose ( matrix2 )



Ceci calcule matrix1 fois transposée de matrix2. *)


let matrix_int_twisted_prod = fun (m:int array array) (mm:int array array) ->

 let r = Array.length m

 and c = Array.length mm

 and t = min ( Array.length m.(0) ) ( Array.length mm.(0) ) in

  let rr = r - 1

  and cc = c - 1

  and tt = t - 1

  and w = Array.make_matrix r c 0 in

   for i = 0 to rr do

    let row_input_left = m.(i)

    and row_output = w.(i) in

     for j = 0 to cc do

      let row_input_right = mm.(j)

      and coeff = ref row_output.(j) in

       for k = 0 to tt do

        coeff := !coeff + row_input_left.(k) * row_input_right.(k)

       done ;

       row_output.(j) <- !coeff

     done ;

   done ;

   w ;;




(** 
matrix_int_prod matrix1 matrix2
 *)


let matrix_int_prod = fun (m:int array array) (mm:int array array) ->

 matrix_int_twisted_prod m ( int_transpose mm ) ;;






(** 
matrix_int_twisted_commut matrix1 matrix2
 *)


let matrix_int_twisted_commut = fun (m:int array array) (mm:int array array) ->

 matrix_int_minus ( matrix_int_twisted_prod m mm ) ( matrix_int_twisted_prod mm m ) ;;




(** 
matrix_int_twisted_commut_bis matrix1 matrix2
 *)


let matrix_int_twisted_commut_bis = fun (m:int array array) (mm:int array array) ->

 let m_m = int_transpose m

 and m_mm = int_transpose mm in

  matrix_int_minus ( matrix_int_twisted_prod m mm ) ( matrix_int_twisted_prod m_mm m_m ) ;;




(** 
matrix_int_commut matrix1 matrix2
 *)


let matrix_int_commut = fun (m:int array array) (mm:int array array) ->

 matrix_int_minus ( matrix_int_prod m mm ) ( matrix_int_prod mm m ) ;;




(** 
matrix_int_triple_prod matrix1 matrix2
 *)


let matrix_int_triple_prod = fun (a:int array array) (b:int array array) (c:int array array) ->

 matrix_int_twisted_prod a ( matrix_int_twisted_prod ( int_transpose c ) b ) ;;




(** 
matrix_int_naive_prod matrix1 matrix2
 *)


let matrix_int_naive_prod = fun (m:int array array) (mm:int array array) ->

 let w = Array.make_matrix (Array.length m) (Array.length mm.(0)) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input_left = m.(i)

   and row_output = w.(i) in

    for j = 0 to (Array.length row_output) - 1 do

     for k = 0 to (Array.length mm) - 1 do

      row_output.(j) <- row_input_left.(k) * mm.(k).(j) + row_output.(j)

     done

    done ;

  done ;

  w ;;




(** 
vector_matrix_int_prod vector matrix
 *)


let vector_matrix_int_prod = fun (v:int array) (m:int array array) ->

 let w = Array.make (Array.length m.(0)) 0 in

  for i = 0 to (Array.length m.(0)) - 1 do

   let row_input = m.(i)

   and output = ref w.(i) in

    for j = 0 to (Array.length m) - 1 do

     output := row_input.(j) * v.(j) + !output

    done ;

    w.(i) <- !output ;

  done ;

  w ;;




(** 
matrix_vector_int_prod vector matrix
 *)


let matrix_vector_int_prod = fun (m:int array array) (v:int array) ->

 let w = Array.make (Array.length m) 0 in

  for i = 0 to (Array.length m) - 1 do

   let row_input = m.(i)

   and output = ref w.(i) in

    for j = 0 to (Array.length v) - 1 do

     output := row_input.(j) * v.(j) + !output

    done ;

    w.(i) <- !output ;

  done ;

  w ;;






(** 
vector_matrix_int_apply function vector matrix
 *)


let vector_matrix_int_apply = fun (f:int -> int -> int) (v:int array) (m:int array array) ->

 let l = Array.length m

 and c = Array.length m.(0) in

  let cc = c - 1

  and w = Array.make_matrix l c 0 in

   for i = 0 to l - 1 do

    let row_input = m.(i)

    and row_output = w.(i) in

    for j = 0 to cc do

     row_output.(j) <- f v.(j) row_input.(j)

    done ;

   done ;

   w ;;




(** 
vector_int_apply2 function vector vector
 *)


let vector_int_apply2 = fun (f:int -> int -> int) (u:int array) (v:int array) ->

 let l = Array.length u in

  let w = Array.make l 0 in

   for i = 0 to l - 1 do

    w.(i) <- f u.(i) v.(i)

   done ;

   w ;;




(** 
matrix_int_apply2 function matrix matrix
 *)


let matrix_int_apply2 = fun (f:int -> int -> int) (m:int array array) (w:int array array) ->

 let r = Array.length m

 and cc = Array.length m.(0) - 1 in

  let mm = Array.make_matrix r (Array.length m.(0)) 0 in

   for i = 0 to (Array.length m) - 1 do

    let row_input_left = m.(i)

    and row_input_right = w.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do

      row_output.(j) <- f row_input_left.(j) row_input_right.(j)

     done

    done ;

    mm ;;




(** 
matrix_vector_int_row_apply function vector matrix
 *)


let matrix_vector_int_row_apply = fun (f:int -> int -> int) (m:int array array) (v:int array) ->

 let l = Array.length m

 and c = Array.length m.(0) in

  let cc = c - 1

  and w = Array.make_matrix l c 0 in

   for i = 0 to l - 1 do

    let row_input = m.(i)

    and row_output = w.(i) in

     for j = 0 to cc do

      row_output.(j) <- f row_input.(j) v.(j)

     done ;

   done ;

   w ;;




(** 
matrix_int_row_apply_scal function matrix
 *)


let matrix_int_row_apply_scal = fun (f:int array -> int) (m:int array array) ->

 let l = Array.length m in

  let w = Array.make l 0 in

   for i = 0 to l - 1 do

    let row_input = m.(i) in

     w.(i) <- f row_input

   done ;

   w ;;




(** 
matrix_int_column_apply_scal function matrix
 *)


let matrix_int_column_apply_scal = fun (f:int array -> int) (m:int array array) ->

 matrix_int_row_apply_scal f ( int_transpose m ) ;;




(** 
matrix_int_row_apply_vect function matrix
 *)


let matrix_int_row_apply_vect = fun (f:int array -> int array) (m:int array array) ->

 let l = Array.length m in

  let w = Array.make l ( f m.(0) ) in

   for i = 0 to l - 1 do

    let row_input = m.(i) in

     w.(i) <- f row_input

   done ;

   w ;;




(** 
matrix_int_column_apply_vect function matrix
 *)


let matrix_int_column_apply_vect = fun (f:int array -> int array) (m:int array array) ->

 int_transpose ( matrix_int_row_apply_vect f ( int_transpose m ) ) ;;






(** 
int_sym matrix
 *)


let int_sym = function (m:int array array) ->

 matrix_int_scal_left_div 2 ( matrix_int_plus (int_transpose m) m ) ;;




(** 
int_antisym matrix
 *)


let int_antisym = function (m:int array array) ->

 matrix_int_scal_left_div 2 ( matrix_int_minus m (int_transpose m) ) ;;






(** 
vector_int_norm_inf vector
 *)


let vector_int_norm_inf = function (v:int array) ->

 let accu = ref (- max_int) in

  for i = 0 to (Array.length v) - 1 do

   accu := Util.int_max ( abs v.(i) ) !accu

  done ;

  !accu ;;




(** 
vector_int_norm_1 vector
 *)


let vector_int_norm_1 = function (v:int array) ->

 let accu = ref 0 in

  for i = 0 to (Array.length v) - 1 do

   accu := ( abs v.(i) ) + !accu

  done ;

  !accu ;;






(** 
matrix_int_norm_inf matrix
 *)


let matrix_int_norm_inf = function (m:int array array) ->

 let accu = ref (- max_int) in

  for i = 0 to (Array.length m) - 1 do

   let accumul = ref 0

   and row_input = m.(i) in

    for j = 0 to (Array.length row_input) - 1 do

     accumul := ( abs row_input.(j) ) + !accumul

    done ;

    accu := Util.int_max !accumul !accu

  done ;

  !accu ;;




(** 
matrix_int_norm_1 matrix
 *)


let matrix_int_norm_1 = function (m:int array array) ->

 matrix_int_norm_inf ( int_transpose m ) ;;




(** 
matrix_int_non_diagonality norm matrix
 *)


let matrix_int_non_diagonality = fun (distance:int array array -> int) (m:int array array) ->

 let mm = matrix_int_minus m ( diag_int (extract_diag m) ) in

  distance mm ;;




(** 
matrix_int_non_scalarity norm matrix
 *)


let matrix_int_non_scalarity = fun (distance:int array array -> int) (m:int array array) ->

 let r = Array.length m in

  let mm = matrix_int_scal_left_sub ( (int_trace m) / r ) m in

   distance mm ;;










(** 
§ 
 *)



(**

Calcul substantiel sur les matrices


Substantial calculus on matrices

*)



(** 
 
 *)











(** 
float_diag_left_mult vector matrix
 *)


let float_diag_left_mult = fun (d:float array) (m:float array array) ->

 let r = min (Array.length m) (Array.length d)

 and cc = ( Array.length m.(0) ) - 1 in

  let mm = Array.make_matrix r ( cc + 1 ) 0. in

   for i = 0 to r - 1 do

    let x = d.(i)

    and row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do 

      row_output.(j) <- x *. row_input.(j)

     done

   done ;

   mm ;;




(** 
float_diag_left_div vector matrix
 *)


let float_diag_left_div = fun (d:float array) (m:float array array) ->

 let r = min (Array.length m) (Array.length d)

 and cc = ( Array.length m.(0) ) - 1 in

  let mm = Array.make_matrix r ( cc + 1 ) 0. in

   for i = 0 to r - 1 do

    let x = d.(i)

    and row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do 

      row_output.(j) <- row_input.(j) /. x

     done

   done ;

   mm ;;




(** 
float_diag_right_mult vector matrix
 *)


let float_diag_right_mult = fun (d:float array) (m:float array array) ->

 let r = min (Array.length m) (Array.length d)

 and cc = ( Array.length m.(0) ) - 1 in

  let mm = Array.make_matrix r ( cc + 1 ) 0. in

   for i = 0 to r - 1 do

    let row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do 

      row_output.(j) <- d.(j) *. row_input.(j)

     done

   done ;

   mm ;;




(** 
float_diag_right_div vector matrix
 *)


let float_diag_right_div = fun (d:float array) (m:float array array) ->

 let r = min (Array.length m) (Array.length d)

 and cc = ( Array.length m.(0) ) - 1 in

  let mm = Array.make_matrix r ( cc + 1 ) 0. in

   for i = 0 to r - 1 do

    let row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do 

      row_output.(j) <- row_input.(j) /. d.(j)

     done

   done ;

   mm ;;






(** 
int_diag_left_mult vector matrix
 *)


let int_diag_left_mult = fun (d:int array) (m:int array array) ->

 let r = min (Array.length m) (Array.length d)

 and cc = ( Array.length m.(0) ) - 1 in

  let mm = Array.make_matrix r ( cc + 1 ) 0 in

   for i = 0 to r - 1 do

    let x = d.(i)

    and row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do 

      row_output.(j) <- x * row_input.(j)

     done

   done ;

   mm ;;




(** 
int_diag_left_div vector matrix
 *)


let int_diag_left_div = fun (d:int array) (m:int array array) ->

 let r = min (Array.length m) (Array.length d)

 and cc = ( Array.length m.(0) ) - 1 in

  let mm = Array.make_matrix r ( cc + 1 ) 0 in

   for i = 0 to r - 1 do

    let x = d.(i)

    and row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do 

      row_output.(j) <- row_input.(j) / x

     done

   done ;

   mm ;;




(** 
int_diag_right_mult vector matrix
 *)


let int_diag_right_mult = fun (d:int array) (m:int array array) ->

 let r = min (Array.length m) (Array.length d)

 and cc = ( Array.length m.(0) ) - 1 in

  let mm = Array.make_matrix r ( cc + 1 ) 0 in

   for i = 0 to r - 1 do

    let row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do 

      row_output.(j) <- d.(j) * row_input.(j)

     done

   done ;

   mm ;;




(** 
int_diag_right_div vector matrix
 *)


let int_diag_right_div = fun (d:int array) (m:int array array) ->

 let r = min (Array.length m) (Array.length d)

 and cc = ( Array.length m.(0) ) - 1 in

  let mm = Array.make_matrix r ( cc + 1 ) 0 in

   for i = 0 to r - 1 do

    let row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to cc do 

      row_output.(j) <- row_input.(j) / d.(j)

     done

   done ;

   mm ;;








(** 
float_slow_pivot_downward i m p
 The matrix m is assumed to be upper triangular from line 0 to i - 1.
The matrix p registers the same changes as m.
Output: pivot acted on the matrix m, pivot acted on the matrix p, 
pair of permutation indexes, value of the inverse of the pivot.



La matrice m est supposée, de la ligne 0 à i - 1, triangulaire supérieure. 
La matrice p enregistre les mêmes changements que m.
Sortie : pivot effectué sur la matrice m, pivot effecturé sur la matrice p, 
paire d'indices de permutation, valeur de l'inverse du pivot. *)


let float_slow_pivot_downward = fun (i:int) (m:float array array) (p:float array array) ->

 let r = Array.length m

 and mmmm = ref (matrix_float_copy m)

 and pppp = ref (matrix_float_copy p)

 and c = numcolumns m in

  let s = min r c 

  and permutation = ref ( [| [| 0. ; 0. |] |] )

  and mm = float_sub_matrix m i (r - 1) i (c - 1) in 

   let mmm = matrix_float_abs mm in

    let plusgrand = matrix_max mmm in

     let index = matrix_float_find_first plusgrand mmm in

      if index.(0) <> 0 then 

       begin

        mmmm := exchange_row i (i+index.(0)) !mmmm ;

        pppp := exchange_row i (i+index.(0)) !pppp ;

       end ;

      if index.(1) <> 0 then 

       begin

        permutation := float_of_matrix [| [| i ; i+index.(1) |] |] ;

        mmmm := exchange_column i (i+index.(1)) !mmmm ;

       end ;

      let coefficient = !mmmm.(i).(i) in

       if coefficient == 0. then failwith "Division by zero in Matrix.float_slow_pivot_downward." ;

       let row = vector_float_scal_left_div coefficient !mmmm.(i) 

       and ligne = vector_float_scal_left_div coefficient !pppp.(i) in

       for j = i + 1 to s - 1 do 
                  (** Pay attention to order: attention à l'ordre *)


        let coeff = !mmmm.(j).(i) in 

         !pppp.(j) <- vector_float_minus !pppp.(j) ( vector_float_scal_mult coeff ligne ) ;

         !mmmm.(j) <- partial_float_minus (i + 1) (c - 1) !mmmm.(j) ( partial_float_scal_mult (i + 1) (c - 1) coeff row ) ;

       done ;

       [| !mmmm ; !pppp ; !permutation ; [|[|1. /. coefficient|]|] |]  ;;






(** 
float_restricted_slow_pivot_downward i m
 The matrix m is assumed to be upper triangular from line 0 to i - 1.
Output: pivot acted on the matrix m, value of the pivot, 
flag indicating a transposition of indexes.



La matrice m est supposée, de la ligne 0 à i - 1, triangulaire supérieure.
Sortie : pivot effectué sur la matrice m, valeur du pivot, 
drapeau indiquant une transposition des indices. *)


let float_restricted_slow_pivot_downward = fun (i:int) (m:float array array) ->

 let r = Array.length m

 and change_sign = ref false

 and flag = ref 0.

 and mmmm = ref (matrix_float_copy m)

 and c = numcolumns m in

  let s = min r c 

  and mm = float_sub_matrix m i (r - 1) i (c - 1) in 

   let mmm = matrix_float_abs mm in

    let plusgrand = matrix_max mmm in

     let index = matrix_float_find_first plusgrand mmm in

      if index.(0) <> 0 then 

       begin

        change_sign := not !change_sign ;

        mmmm := exchange_row i ( i + index.(0) ) !mmmm ;

       end ;

      if index.(1) <> 0 then 

       begin

        change_sign := not !change_sign ;

        mmmm := exchange_column i ( i + index.(1) ) !mmmm ;

       end ;

      let coefficient = !mmmm.(i).(i) in

       if ( coefficient <> 0. ) then

        begin

         let row = vector_float_scal_left_div coefficient !mmmm.(i) in

          for j = i + 1 to s - 1 do 

           let coeff = !mmmm.(j).(i) in 

            !mmmm.(j) <- partial_float_minus (i + 1) (c - 1) !mmmm.(j) ( partial_float_scal_mult (i + 1) (c - 1) coeff row ) ;

          done ;

        end ;

        if !change_sign then flag := 1. else flag := 0. ;

        [| !mmmm ; [|[| coefficient |]|] ; [|[| !flag |]|] |] ;;






(** 
float_slow_pivot_upward i m p
 The matrix m is assumed to be diagonal from line i + 1 to r - 1.
The matrix p registers the same changes as m.
Output: pivot acted on the matrix m, pivot acted on the matrix p.



La matrice m est supposée, de la ligne i + 1 à r - 1, diagonale. 
La matrice p enregistre les memes changements que m.
Sortie : pivot effectué sur la matrice m, pivot effecturé sur la matrice p. *)


let float_slow_pivot_upward = fun (i:int) (m:float array array) (p:float array array) (coefficient:float) ->

 let mmmm = ref (matrix_float_copy m)

 and pppp = ref (matrix_float_copy p) in

  let row = vector_float_scal_mult coefficient !mmmm.(i) 

  and ligne = vector_float_scal_mult coefficient !pppp.(i) in

   for j = i - 1 downto 0 do 
            (** Pay attention to order : attention à l'ordre *)


    let coeff = !mmmm.(j).(i) in 

     !pppp.(j) <- vector_float_minus !pppp.(j) ( vector_float_scal_mult coeff ligne ) ;

     !mmmm.(j) <- partial_float_minus j (i - 1) !mmmm.(j) ( partial_float_scal_mult j (i - 1) coeff row ) ;

   done ;

   [| !mmmm ; !pppp |];;






(** 
float_slow_inv matrix
 *)


let float_slow_inv = function (m:float array array) ->

 let r = ( min (numrows m) (numcolumns m) ) 

 and mm = ref (matrix_float_copy m)

 and permucol = ref []

 and pp = ref ( identity_float (Array.length m) (Array.length m.(0)) ) in

  let diagonale = Array.make r 0.

  and rr = pred r in

   for i = 0 to r - 2 do

    let resultat = float_slow_pivot_downward i !mm !pp in

     mm := resultat.(0) ;

     pp := resultat.(1) ;

     permucol := resultat.(2) :: !permucol ;

     diagonale.(i) <- resultat.(3).(0).(0)

   done ;

   let coeff = !mm.(rr).(rr) in

    if coeff == 0. then failwith "Division by zero in Matrix.float_slow_inv." ;

    diagonale.(rr) <- 1. /. coeff ;

   for i = rr downto 1 do

    let resultat = float_slow_pivot_upward i !mm !pp diagonale.(i) in

     mm := resultat.(0) ;

     pp := resultat.(1) ;

   done ;

    mm := float_diag_left_mult diagonale !pp ;

    let index = ref [| [| 0 ; 0 |] |] in

     while Util.list_non_empty !permucol do

      index := int_of_matrix ( List.hd !permucol ) ;

      mm := exchange_row (!index.(0).(0)) (!index.(0).(1)) !mm ;

      permucol := List.tl !permucol ;

     done ;

     !mm ;;






(** 
matrix_float_slow_left_quotient matrix1 matrix2
 *)


let matrix_float_slow_left_quotient = fun (m:float array array) (p:float array array) ->

 let r = ( min (numrows m) (numcolumns m) ) 

 and mm = ref ( matrix_float_copy m )

 and permucol = ref []

 and pp = ref ( matrix_float_copy p ) in

  let diagonale = Array.make r 0.

  and rr = pred r in

   for i = 0 to r - 2 do

    let resultat = float_slow_pivot_downward i !mm !pp in

     mm := resultat.(0) ;

     pp := resultat.(1) ;

     permucol := resultat.(2) :: !permucol ;

     diagonale.(i) <- resultat.(3).(0).(0)

   done ;

   let coeff = !mm.(rr).(rr) in

    if coeff == 0. then failwith "Division by zero in Matrix.float_slow_left_quotient." ;

    diagonale.(rr) <- 1. /. coeff ;

   for i = rr downto 1 do

    let resultat = float_slow_pivot_upward i !mm !pp diagonale.(i) in

     mm := resultat.(0) ;

     pp := resultat.(1) ;

   done ;

    mm := float_diag_left_mult diagonale !pp ;

    let index = ref [| [| 0 ; 0 |] |] in

     while Util.list_non_empty !permucol do

      index := int_of_matrix ( List.hd !permucol ) ;

      mm := exchange_row (!index.(0).(0)) (!index.(0).(1)) !mm ;

      permucol := List.tl !permucol ;

     done ;

     !mm ;;






(** 
matrix_float_slow_right_quotient matrix1 matrix2
 This gives matrix2 * (matrix1) ^ -1.



Ceci retourne matrix2 * (matrix1) ^ -1. *)


let matrix_float_slow_right_quotient = fun (m:float array array) (p:float array array) ->

 float_transpose ( matrix_float_slow_left_quotient (float_transpose m) (float_transpose p) ) ;;






(** 
line_float_slow_left_quotient matrix1 matrix_array
 *)


let line_float_slow_left_quotient = fun (m:float array array) (p:float array array array) ->

 Array.map ( matrix_float_slow_left_quotient m ) p ;;




(** 
line_float_slow_right_quotient matrix1 matrix_array
 *)


let line_float_slow_right_quotient = fun (m:float array array) (p:float array array array) ->

 Array.map ( matrix_float_slow_right_quotient m ) p ;;






(** 
float_slow_invertibility matrix
 *)


let float_slow_invertibility = function (m:float array array) ->

 let r = min (Array.length m) (numcolumns m)

 and mm = ref (matrix_float_copy m) in

  let i = ref 0

  and rr = pred r

  and output = ref true in

   while !i < rr do

    let resultat = float_restricted_slow_pivot_downward !i !mm in

     if ( resultat.(1).(0).(0) = 0. ) then ( i := r ; output := false )

     else

      begin 

       mm := resultat.(0) ;

       i := !i + 1 ;

      end

   done ;

   output := !output && ( !mm.(rr).(rr) <> 0. ) ;

   !output ;;






(** 
float_slow_invertibility_evaluation matrix
 *)


let float_slow_invertibility_evaluation = function (m:float array array) ->

 let r = min (Array.length m) (numcolumns m)

 and mm = ref (matrix_float_copy m) in

  let i = ref 0

  and rr = pred r

  and diagonale = Array.make r 0.

  and output = ref max_float in

   while !i < rr do

    begin

     let resultat = float_restricted_slow_pivot_downward !i !mm in

      let coeff = resultat.(1).(0).(0) in

       if coeff = 0. then ( i := r ; output := 0. )

       else

        begin

         mm := resultat.(0) ;

         diagonale.(!i) <- coeff ;

         i := !i + 1 ;

        end

    end

   done ;

   if !output <> 0. then 

    begin

     diagonale.(rr) <- !mm.(rr).(rr) ;

     let absdiag = vector_float_abs diagonale in

      let mini = vector_float_min absdiag in

       let index = vector_float_find_first mini absdiag in

        diagonale.(index)

    end

   else 0. ;;






(** 
float_slow_det matrix
 *)


let float_slow_det = function (m:float array array) ->

 let r = min (Array.length m) (numcolumns m)

 and change_sign = ref false

 and accu = ref 1.

 and mm = ref (matrix_float_copy m) in

  let i = ref 0

  and rr = pred r

  and diagonale = Array.make r 0. in

   while !i < rr do

    let resultat = float_restricted_slow_pivot_downward !i !mm in

     let coeff = resultat.(1).(0).(0) in

      if coeff = 0. then ( i := r ; accu := 0. )

      else

       begin

        if resultat.(2).(0).(0) <> 0. then change_sign := not !change_sign ;

        mm := resultat.(0) ;

        diagonale.(!i) <- coeff ;

        i := !i + 1

       end

   done ;

   if !accu <> 0. then 

    begin

     for i = 0 to r - 2 do

      accu := diagonale.(i) *. !accu

     done ;

     let candidat = !mm.(rr).(rr) *. !accu in

      if !change_sign then -. candidat else candidat

    end

   else 0. ;;








(** 
float_pivot_downward i m p
 The matrix m is assumed to be upper triangular from line 0 to i - 1.
The matrix p registers the same changes as m.
The coefficients under the diagonal of the output matrix mm are not modified since they wil not be used.
Output: pivot acted on the matrix m, pivot acted on the matrix p, 
pair of permutation indexes, value of the inverse of the pivot.



La matrice m est supposée, de la ligne 0 à i - 1, triangulaire supérieure. 
La matrice p enregistre les memes changements que m.
Les coefficients sous la diagonale de la matrice mm en sortie ne sont pas modifiés puisqu'ils ne seront pas utilisés.
Sortie : pivot effectué sur la matrice m, pivot effecturé sur la matrice p, 
paire d'indices de permutation, valeur de l'inverse du pivot. *)


let float_pivot_downward = fun (i:int) (m:float array array) (p:float array array) ->

 let r = Array.length m

 and mm = matrix_float_copy m

 and pp = identity_float (Array.length m) (Array.length m.(0)) in

  let permutation = ref ( [| [| 0. ; 0. |] |] )

  and rr = pred r

  and accu = ref mm.(i).(i)

  and index = ref i in

   for j = i + 1 to rr do

    if abs_float mm.(j).(i) > abs_float !accu then ( accu := mm.(j).(i) ; index := j )

   done ;

    if !index <> i then 

     begin

      permutation := float_of_matrix [| [| i ; !index |] |] ;

      let aux = mm.(i)

      and auxil = pp.(i) in

       mm.(i) <- mm.(!index) ;

       mm.(!index) <- aux ;

       pp.(i) <- pp.(!index) ;

       pp.(!index) <- auxil 

     end ;

    let row = mm.(i)

    and ligne = pp.(i) in

     let piv = row.(i) in

      if piv == 0. then failwith "Division by zero in Matrix.float_pivot_downward." ;

      let coefficient = 1. /. piv in

       for h = i + 1 to rr do

        let row_output = mm.(h)

        and ligne_sortie = pp.(h) in

         let coeff = row_output.(i) *. coefficient in

          for k = 0 to i do

           ligne_sortie.(k) <- ligne_sortie.(k) -. ligne.(k) *. coeff

          done ;

          for k = i + 1 to rr do

           ligne_sortie.(k) <- ligne_sortie.(k) -. ligne.(k) *. coeff ;

           row_output.(k) <- row_output.(k) -. row.(k) *. coeff

          done ;

       done ;

       [| mm ; pp ; !permutation ; [|[| coefficient |]|] |]  ;;






(** 
float_pivot_upward i m p
 The matrix m is assumed to be diagonal from line i + 1 to r - 1.
The matrix p registers the same changes as m.
Output: pivot acted on the matrix m, pivot acted on the matrix p.



La matrice m est supposée, de la ligne i + 1 à r - 1, diagonale. 
La matrice p enregistre les memes changements que m.
Sortie : pivot effectué sur la matrice m, pivot effecturé sur la matrice p. *)


let float_pivot_upward = fun (i:int) (m:float array array) (p:float array array) (coefficient:float) ->

 let mm = matrix_float_copy m

 and pp = matrix_float_copy p in

  let r = Array.length m

  and ligne = pp.(i) in

     for jj = i - 1 downto 0 do

      let ligne_sortie = pp.(jj) in

       let coeff = mm.(jj).(i) *. coefficient in

        for  kk = 0 to jj do

         ligne_sortie.(kk) <- ligne_sortie.(kk) -. ligne.(kk) *. coeff

        done ;

        for kk = i to r - 1 do

         ligne_sortie.(kk) <- ligne_sortie.(kk) -. ligne.(kk) *. coeff

        done ;

        for kk = jj + 1 to i - 1 do

         ligne_sortie.(kk) <- ligne_sortie.(kk) -. ligne.(kk) *. coeff ;

        done ;

     done ;

     [| mm ; pp |] ;;






(** 
float_inv matrix
 *)


let float_inv = function (m:float array array) ->

 let r = Array.length m

 and mm = matrix_float_copy m

 and pp = identity_float (Array.length m) (Array.length m.(0)) in

  let diagonale = Array.make r 1.

  and rr = pred r in


(** pivot downward : descendant *)


   for i = 0 to r - 2 do

    let accu = ref mm.(i).(i)

    and index = ref i in

     for j = i + 1 to rr do

      if abs_float mm.(j).(i) > abs_float !accu then ( accu := mm.(j).(i) ; index := j )

     done ;

      if !index <> i then 

       begin

        let aux = mm.(i)

        and auxil = pp.(i) in

         mm.(i) <- mm.(!index) ;

         mm.(!index) <- aux ;

         pp.(i) <- pp.(!index) ;

         pp.(!index) <- auxil 

       end ;

      let row = mm.(i)

      and ligne = pp.(i) in

       let piv = row.(i) in

        if piv == 0. then failwith "Division by zero in Matrix.float_inv." ;

        let coefficient = 1. /. piv in

         diagonale.(i) <- coefficient ;

         for h = i + 1 to rr do

          let row_output = ref mm.(h)

          and ligne_sortie = ref pp.(h) in

           let coeff = !row_output.(i) *. coefficient in

            for k = 0 to i do

             !ligne_sortie.(k) <- !ligne_sortie.(k) -. ligne.(k) *. coeff

            done ;

            for k = i + 1 to rr do

             !ligne_sortie.(k) <- !ligne_sortie.(k) -. ligne.(k) *. coeff ;

             !row_output.(k) <- !row_output.(k) -. row.(k) *. coeff

            done ;

            pp.(h) <- !ligne_sortie ;

            mm.(h) <- !row_output

         done ;

   done ;

   let piv = mm.( rr ).( rr ) in

    if piv == 0. then failwith "Division by zero at the last row in Matrix.float_inv." ;

    diagonale.( rr ) <- 1. /. piv ;


(** pivot upward : montant *)


   for ii = rr downto 1 do

    let ligne = pp.(ii) in

     let coefficient = diagonale.(ii) in

      for jj = ii - 1 downto 0 do

       let ligne_sortie = ref pp.(jj) in

        let coeff = mm.(jj).(ii) *. coefficient in

         for  kk = 0 to rr do

          !ligne_sortie.(kk) <- !ligne_sortie.(kk) -. ligne.(kk) *. coeff

         done ;

         pp.(jj) <- !ligne_sortie ;

      done

   done ;


(** diagonale *)


   for hh = 0 to rr do

    let row_right = ref pp.(hh)

    and coeff_diag = diagonale.(hh) in

     for ll = 0 to rr do

      !row_right.(ll) <- !row_right.(ll) *. coeff_diag

     done ;

    pp.(hh) <- !row_right

   done ;

   pp ;;






(** 
matrix_float_left_quotient matrix1 matrix2
 *)


let matrix_float_left_quotient = fun (m:float array array) (p:float array array) ->

 let r = Array.length m

 and mm = matrix_float_copy m

 and pp = matrix_float_copy p in

  let diagonale = Array.make r 1.

  and rr = pred r in


(** pivot downward : descendant *)


   for i = 0 to r - 2 do

    let accu = ref mm.(i).(i)

    and index = ref i in

     for j = i + 1 to rr do

      if abs_float mm.(j).(i) > abs_float !accu then ( accu := mm.(j).(i) ; index := j )

     done ;

      if !index <> i then 

       begin

        let aux = mm.(i)

        and auxil = pp.(i) in

         mm.(i) <- mm.(!index) ;

         mm.(!index) <- aux ;

         pp.(i) <- pp.(!index) ;

         pp.(!index) <- auxil 

       end ;

      let row = mm.(i)

      and ligne = pp.(i) in

       let piv = row.(i) in

        if piv == 0. then failwith "Division by zero in Matrix.float_left_quotient." ;

        let coefficient = 1. /. piv in

         diagonale.(i) <- coefficient ;

         for h = i + 1 to rr do

          let row_output = ref mm.(h)

          and ligne_sortie = ref pp.(h) in

           let coeff = !row_output.(i) *. coefficient in

            for k = 0 to i do

             !ligne_sortie.(k) <- !ligne_sortie.(k) -. ligne.(k) *. coeff

            done ;

            for k = i + 1 to rr do

             !ligne_sortie.(k) <- !ligne_sortie.(k) -. ligne.(k) *. coeff ;

             !row_output.(k) <- !row_output.(k) -. row.(k) *. coeff

            done ;

            pp.(h) <- !ligne_sortie ;

            mm.(h) <- !row_output

         done ;

   done ;

   let piv = mm.( rr ).( rr ) in

    if piv == 0. then failwith "Division by zero at the last row in Matrix.float_left_quotient." ;

    diagonale.( rr ) <- 1. /. piv ;


(** pivot upward : montant *)


  for ii = rr downto 1 do

   let ligne = pp.(ii) in

    let coefficient = diagonale.(ii) in

     for jj = ii - 1 downto 0 do

      let ligne_sortie = ref pp.(jj) in

       let coeff = mm.(jj).(ii) *. coefficient in

        for  kk = 0 to rr do

         !ligne_sortie.(kk) <- !ligne_sortie.(kk) -. ligne.(kk) *. coeff

        done ;

        pp.(jj) <- !ligne_sortie ;

     done

  done ;


(** diagonale *)


  for hh = 0 to rr do

   let row_right = ref pp.(hh)

   and coeff_diag = diagonale.(hh) in

    for ll = 0 to rr do

     !row_right.(ll) <- !row_right.(ll) *. coeff_diag

    done ;

   pp.(hh) <- !row_right

  done ;

  pp ;;






(** 
matrix_float_right_quotient matrix1 matrix2
 This gives matrix2 * (matrix1) ^ -1.



Ceci retourne matrix2 * (matrix1) ^ -1. *)


let matrix_float_right_quotient = fun (m:float array array) (p:float array array) ->

 float_transpose ( matrix_float_left_quotient (float_transpose m) (float_transpose p) ) ;;




(** 
line_float_left_quotient matrix1 matrix_array
 *)


let line_float_left_quotient = fun (m:float array array) (p:float array array array) ->

 Array.map (matrix_float_left_quotient m) p ;;




(** 
line_float_right_quotient matrix1 matrix_array
 *)


let line_float_right_quotient = fun (m:float array array) (p:float array array array) ->

 Array.map (matrix_float_right_quotient m) p ;;






(** 
float_invertibility matrix
 *)


let float_invertibility = function (m:float array array) ->

 let r = Array.length m

 and mm = matrix_float_copy m

 and resultat = ref true

 and i = ref 0 in

  let rr = pred r in

   while !i <= r - 2 do

    let accu = ref mm.(!i).(!i)

    and index = ref !i in

     for j = !i + 1 to rr do

      if abs_float mm.(j).(!i) > abs_float !accu then ( accu := mm.(j).(!i) ; index := j )

     done ;

     if !accu = 0. then ( resultat := false ; i := r )

     else 

      begin

       if !index <> !i then 

        begin

         let aux = mm.(!i) in

          mm.(!i) <- mm.(!index) ;

          mm.(!index) <- aux

        end ;

       let row = mm.(!i) in

        let coefficient = 1. /. !accu in

         for h = !i + 1 to rr do

          let row_output = ref mm.(h) in

           let coeff = !row_output.(!i) in

            for k = !i + 1 to rr do

             !row_output.(k) <- !row_output.(k) -. row.(k) *. coeff *. coefficient

            done ;

           mm.(h) <- !row_output

         done ;

         i := !i + 1 

      end

   done ;

   let x = mm.(rr).(rr) in

    if ( x = 0. ) then ( resultat := false ) ;

    !resultat ;;






(** 
float_invertibility_evaluation matrix
 *)


let float_invertibility_evaluation = function (m:float array array) ->

 let r = Array.length m

 and mm = matrix_float_copy m

 and resultat = ref max_float

 and i = ref 0 in

  let rr = pred r in

   while !i <= r - 2 do

    let accu = ref mm.(!i).(!i)

    and index = ref !i in

     for j = !i + 1 to rr do

      if abs_float mm.(j).(!i) > abs_float !accu then ( accu := mm.(j).(!i) ; index := j )

     done ;

     if !accu = 0. then ( resultat := 0. ; i := r )

     else 

      begin

       if ( (abs_float !accu) < (abs_float !resultat) ) then resultat := !accu ;

       if !index <> !i then 

        begin

         let aux = mm.(!i) in

          mm.(!i) <- mm.(!index) ;

          mm.(!index) <- aux

        end ;

       let row = mm.(!i) in

        let coefficient = 1. /. !accu in

         for h = !i + 1 to rr do

          let row_output = ref mm.(h) in

           let coeff = !row_output.(!i) in

            for k = !i + 1 to rr do

             !row_output.(k) <- !row_output.(k) -. row.(k) *. coeff *. coefficient

            done ;

           mm.(h) <- !row_output

         done ;

         i := !i + 1 

      end

   done ;

   let x = mm.(rr).(rr) in

    if ( abs_float x < abs_float !resultat ) then ( resultat := x ) ;

    !resultat ;;






(** 
float_det matrix
 *)


let float_det = function (m:float array array) ->

 let r = Array.length m

 and change_sign = ref false

 and mm = matrix_float_copy m

 and resultat = ref 1.

 and i = ref 0 in

  let rr = pred r in

   while !i <= r - 2 do

    let accu = ref mm.(!i).(!i)

    and index = ref !i in

     for j = !i + 1 to rr do

      if abs_float mm.(j).(!i) > abs_float !accu then ( accu := mm.(j).(!i) ; index := j )

     done ;

     if !accu = 0. then ( resultat := 0. ; i := r )

     else 

      begin

       resultat := !accu *. !resultat ;

       if !index <> !i then 

        begin

         change_sign := not !change_sign ;

         let aux = mm.(!i) in

          mm.(!i) <- mm.(!index) ;

          mm.(!index) <- aux

        end ;

       let row = mm.(!i) in

        let coefficient = 1. /. !accu in

         for h = !i + 1 to rr do

          let row_output = ref mm.(h) in

           let coeff = !row_output.(!i) in

            for k = !i + 1 to rr do

             !row_output.(k) <- !row_output.(k) -. row.(k) *. coeff *. coefficient

            done ;

           mm.(h) <- !row_output

         done ;

         i := !i + 1 

      end

   done ;

   let x = mm.(rr).(rr) in

    resultat := x *. !resultat ;

    if !change_sign then -. !resultat else !resultat ;;






(** 
float_dirty_inv matrix
 This may apply to matrices near identity.



Ceci devrait s'appliquer aux matrices proches de l'identité. *)


let float_dirty_inv = function (m:float array array) ->

 let r = Array.length m in

  let mm = Array.make_matrix r r 0.

  and rr = pred r in

   for i = 0 to rr do

    let row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to i - 1 do

      row_output.(j) <- -. row_input.(j)

     done ;

     row_output.(i) <- 2. -. row_input.(i) ;

     for j = i + 1 to rr do

      row_output.(j) <- -. row_input.(j)

     done ;

     mm.(i) <- row_output

   done ;

   mm ;;




(** 
other_float_dirty_inv matrix
 This may apply to matrices near identity.



Ceci devrait s'appliquer aux matrices proches de l'identité. *)


let other_float_dirty_inv = function (m:float array array) ->

 let t = ref ( float_trace m )

 and r = Array.length m in

  let mm = Array.make_matrix r r 0.

  and rr = pred r in

   if !t = 0. then ( t := 2. *. (matrix_float_norm_inf m) /. (float r) ) else ( t := 2. *. !t /. (float r) ) ;

   for i = 0 to rr do

    let row_input = m.(i)

    and row_output = mm.(i) in

     for j = 0 to i - 1 do

      row_output.(j) <- -. row_input.(j)

     done ;

     row_output.(i) <- !t -. row_input.(i) ;

     for j = i + 1 to rr do

      row_output.(j) <- -. row_input.(j)

     done ;

     mm.(i) <- row_output

   done ;

   mm ;;






(** 
slow_float_tune_inv norm matrix matrix_inv_candidate
 This is taken from the HP15C calulator's high level mathematical functions manual.



Input : <matrix> = x ; <matrix_inv_candidate> = y with y = x ^ -1 + epsilon ; <norm> may be any norm on matrices.



Output = < candidate ; error > with



candidate = 2 * y - y * x * y  and



error = norm ( x * candidate - Id ) <= || x || ^ 2 * || epsilon || ^ 2.
Ceci provient du manuel des fonctions mathématiques de haut niveau de la calculette HP15C. *)


let slow_float_tune_inv = fun (distance:float array array -> float) (x:float array array) (y:float array array) ->

 let mm = matrix_float_prod x y

 and r = Array.length x in

  let lambda = scal_float r r 2.

  and delta = matrix_float_minus ( matrix_float_scal_mult 2. mm ) ( matrix_float_prod mm mm ) in

   let candidate = matrix_float_prod y ( matrix_float_minus lambda mm )

   and error = distance ( matrix_float_minus delta (identity_float r r) ) in

    [| candidate ; [|[|error|]|] |] ;;






(** 
float_tune_inv norm matrix matrix_inv_candidate
 This is taken from the HP15C calulator's high level mathematical functions manual.



Input : <matrix> = x ; <matrix_inv_candidate> = y with y = x ^ -1 + epsilon ; <norm> may be any norm on matrices.



Output = < candidate ; error > with



candidate = 2 * y - y * x * y  and



error = norm ( x * candidate - Id ) <= || x || ^ 2 * || epsilon || ^ 2.
Ceci provient du manuel des fonctions mathématiques de haut niveau de la calculette HP15C. *)


let float_tune_inv = fun (distance:float array array -> float) (x:float array array) (y:float array array) ->

 let r = Array.length x in

  let mm = Array.make_matrix r r 0.

  and rr = r - 1 in

   for i = 0 to rr do

    begin

     let row_left = x.(i)

     and row_output = mm.(i) in

      for j = 0 to rr do

       let coeff = ref row_output.(j) in

        for k = 0 to rr do

         coeff := !coeff +. row_left.(k) *. y.(k).(j)

        done ;

        row_output.(j) <- !coeff

      done ;

      mm.(i) <- row_output

    end

   done ;

   let candidate = Array.make_matrix r r 0. in

   for i = 0 to rr do

    begin

     let row_LEFT = y.(i)

     and row_OUTPUT = candidate.(i) in

      for j = 0 to rr do

       let coeff = ref row_OUTPUT.(j) in

        for k = 0 to rr do

         coeff := !coeff +. row_LEFT.(k) *. mm.(k).(j)

        done ;

        coeff := 2. *. row_LEFT.(j) -. !coeff ;

        row_OUTPUT.(j) <- !coeff

      done ;

      candidate.(i) <- row_OUTPUT

    end

   done ;

   let delta = Array.make_matrix r r 0. in

   for i = 0 to rr do

    begin

     let row_Left = x.(i)

     and row_Output = delta.(i) in

      begin

       for j = 0 to rr do

        let coeff = ref row_Output.(j) in

         for k = 0 to rr do

          coeff := !coeff +. row_Left.(k) *. candidate.(k).(j)

         done ;

         row_Output.(j) <- !coeff

       done ;

       row_Output.(i) <- row_Output.(i) -. 1.

      end ;

      delta.(i) <- row_Output

    end

   done ;

   let error = distance delta in

    [| candidate ; [|[|error|]|] |] ;;






(** 
slow_float_approx_inv norm invertor matrix
 If invertor = float_dirty_inv, then this may apply only to matrices near identity.
In other cases, it may enhance the precision of the result.



Dans le cas où l'inverseur vaut invertor = float_dirty_inv, ceci ne devrait s'appliquer qu'aux matrices proches de l'identité.
Dans les autres cas, la précision du résultat pourrait être améliorée. *)


let slow_float_approx_inv = fun (distance:float array array -> float) (invertor:float array array -> float array array) (x:float array array) ->

 let y = invertor x

 and r = Array.length x in

  let product = matrix_float_prod x y

  and result = slow_float_tune_inv distance x y in

   let error0 = distance ( matrix_float_minus product (identity_float r r) )

   and error1 = result.(1).(0).(0)

   and z = result.(0) in

    if error1 >= error0 then [| y ; [|[| error0 |]|] |] else [| z ; [|[| error1 |]|] |] ;; 






(** 
float_approx_inv norm invertor matrix
 If invertor = float_dirty_inv, then this may apply only to matrices near identity.
In other cases, it may enhance the precision of the result.



Dans le cas où l'inverseur vaut invertor = float_dirty_inv, ceci ne devrait s'appliquer qu'aux matrices proches de l'identité.
Dans les autres cas, la précision du résultat pourrait être améliorée. *)


let float_approx_inv = fun (distance:float array array -> float) (invertor:float array array -> float array array) (x:float array array) ->

 let y = invertor x

 and r = Array.length x in

  let product = matrix_float_prod x y

  and result = float_tune_inv distance x y in

   let error0 = distance ( matrix_float_minus product (identity_float r r) )

   and error1 = result.(1).(0).(0)

   and z = result.(0) in

    if error1 >= error0 then [| y ; [|[| error0 |]|] |] else [| z ; [|[| error1 |]|] |] ;; 






(** 
slow_float_loop_approx_inv norm invertor matrix
 If invertor = float_dirty_inv, then this may apply only to matrices near identity.
In other cases, it may enhance the precision of the result.



Dans le cas où invertor = float_dirty_inv, ceci ne devrait s'appliquer qu'aux matrices proches de l'identité.
Dans les autres cas, la précision du résultat pourrait être améliorée. *)


let slow_float_loop_approx_inv = fun (distance:float array array -> float) (invertor:float array array -> float array array) (x:float array array) ->

 let y = ref (invertor x)

 and r = Array.length x in

  let product = matrix_float_prod x !y in

   let error0 = ref max_float

   and error1 = ref ( distance ( matrix_float_minus product (identity_float r r) ) ) in

    while error1 < error0 do

     begin

      let result = slow_float_tune_inv distance x !y in

       let error2 = ref ( result.(1).(0).(0) ) in

        if !error2 < !error1 then

         begin

          error0 := !error1 ;

          error1 := !error2 ;

          y := result.(0)

         end

        else error0 := !error1

     end

    done ;

    [| !y ; [|[| !error1 |]|] |] ;;






(** 
slow_float_target_inv norm invertor threshold matrix
 If invertor = float_dirty_inv, then this may apply only to matrices near identity.
In other cases, it may enhance the precision of the result. The stop test is evaluated on the candidate for the inverse.



Dans le cas où invertor = float_dirty_inv, ceci ne devrait s'appliquer qu'aux matrices proches de l'identité.
Dans les autres cas, la précision du résultat pourrait être améliorée.
Le test d'arrêt est réalisé sur le candidat inverse. *)


let slow_float_target_inv = fun (distance:float array array -> float) (invertor:float array array -> float array array) (threshold:float) (x:float array array) ->

 let y = ref ( zeros_float x )

 and z = ref ( invertor x ) in

  let error0 = ref 0.

  and error1 = ref ( distance !z ) in

   while ( !error1 > threshold ) or ( !error1 > !error0 ) do

    begin

     y := !z ;

     error0 := !error1 ;

     let result = slow_float_tune_inv distance x !y in

      z := result.(0) ;

      error1 := distance ( matrix_float_minus !z !y ) ;

    end

   done ;

   [| !z ; [|[| !error1 |]|] |] ;;






(** 
float_loop_approx_inv norm invertor matrix
 If invertor = float_dirty_inv, then this may apply only to matrices near identity.
In other cases, it may enhance the precision of the result.



Dans le cas où invertor = float_dirty_inv, ceci ne devrait s'appliquer qu'aux matrices proches de l'identité.
Dans les autres cas, la précision du résultat pourrait être améliorée. *)


let float_loop_approx_inv = fun (distance:float array array -> float) (invertor:float array array -> float array array) (x:float array array) ->

 let y = ref (invertor x)

 and r = Array.length x in

  let product = matrix_float_prod x !y in

   let error0 = ref max_float

   and error1 = ref ( distance ( matrix_float_minus product (identity_float r r) ) ) in

    while error1 < error0 do

     begin

      let result = float_tune_inv distance x !y in

       let error2 = ref ( result.(1).(0).(0) ) in

        if !error2 < !error1 then

         begin

          error0 := !error1 ;

          error1 := !error2 ;

          y := result.(0)

         end

        else error0 := !error1

     end

    done ;

    [| !y ; [|[| !error1 |]|] |] ;;






(** 
float_target_inv norm invertor threshold matrix
 If invertor = float_dirty_inv, then this may apply only to matrices near identity.
In other cases, it may enhance the precision of the result. The stop test is evaluated on the candidate for the inverse.



Dans le cas où invertor = float_dirty_inv, ceci ne devrait s'appliquer qu'aux matrices proches de l'identité.
Dans les autres cas, la précision du résultat pourrait être améliorée.
Le test d'arrêt est réalisé sur le candidat inverse. *)


let float_target_inv = fun (distance:float array array -> float) (invertor:float array array -> float array array) (threshold:float) (x:float array array) ->

 let y = ref ( zeros_float x )

 and z = ref ( invertor x ) in

  let error0 = ref 0.

  and error1 = ref ( distance !z ) in

   while ( !error1 > threshold ) or ( !error1 > !error0 ) do

    begin

     y := !z ;

     error0 := !error1 ;

     let result = float_tune_inv distance x !y in

      z := result.(0) ;

      error1 := distance ( matrix_float_minus !z !y ) ;

    end

   done ;

   if error1 < error0 then [| !z ; [|[| !error1 |]|] |]

   else [| !y ; [|[| !error0 |]|] |] ;;






(** 
float_target_inv_seq norm invertor threshold matrix
 If invertor = float_dirty_inv, then this may apply only to matrices near identity.
In other cases, it may enhance the precision of the result. The stop test is evaluated on the candidate for the inverse.



Dans le cas où invertor = float_dirty_inv, ceci ne devrait s'appliquer qu'aux matrices proches de l'identité.
Dans les autres cas, la précision du résultat pourrait être améliorée.
Le test d'arrêt est réalisé sur le candidat inverse. *)


let float_target_inv_seq = fun (distance:float array array -> float) (invertor:float array array -> float array array) (threshold:float) (x:float array array) ->

 let y = ref ( zeros_float x )

 and z = ref ( invertor x ) in

  let error0 = ref 0.

  and seq = ref [| matrix_float_copy !z |]

  and error1 = ref ( distance !z ) in

   while ( !error1 > threshold ) or ( !error1 > !error0 ) do

    begin

     y := !z ;

     error0 := !error1 ;

     let result = float_tune_inv distance x !y in

      z := result.(0) ;

      seq := Array.append !seq [| matrix_float_copy !z |] ;

      error1 := distance ( matrix_float_minus !z !y ) ;

    end

   done ;

   if error1 >= error0 then seq := Array.sub !seq 1 ( pred ( Array.length !seq ) ) ;

   !seq ;;






(** 
float_target_inv_seq accelearator norm invertor threshold matrix
 If invertor = float_dirty_inv, then this may apply only to matrices near identity.
In other cases, it may enhance the precision of the result. The stop test is evaluated on the candidate for the inverse.



Dans le cas où invertor = float_dirty_inv, ceci ne devrait s'appliquer qu'aux matrices proches de l'identité.
Dans les autres cas, la précision du résultat pourrait être améliorée.
Le test d'arrêt est réalisé sur le candidat inverse. *)


let float_compensated_target_inv = fun accelerator (distance:float array array -> float) (invertor:float array array -> float array array) (threshold:float) (x:float array array) ->

 let s = float_target_inv_seq distance invertor threshold x in

  accelerator s ;;






(** 
float_cond norm invertor matrix
 *)


let float_cond = fun (distance:float array array -> float) (invertor:float array array -> float array array) (m:float array array) ->

(distance m) *. ( distance (invertor m) ) ;;






(** 
float_naive_solve invertor matrix vector
 *)


let float_naive_solve = fun (invertor:float array array -> float array array) (m:float array array) (v:float array) ->

 matrix_vector_float_prod (invertor m) v ;;




(** 
float_solve matrix vector
 *)


let float_solve = fun (m:float array array) (v:float array) ->

 let p = float_transpose [| v |] in

  let x = matrix_float_left_quotient m p in

   ( float_transpose x ).(0) ;;




(** 
float_slow_solve matrix vector
 *)


let float_slow_solve = fun (m:float array array) (v:float array) ->

 let p = float_transpose [| v |] in

  let x = matrix_float_slow_left_quotient m p in

   ( float_transpose x ).(0) ;;






(** 
int_det matrix
 *)


let int_det = function (m:int array array) ->

 let mm = float_of_matrix m in

  let d = float_det mm in

   Util.round d ;;




(** 
int_slow_det matrix
 *)


let int_slow_det = function (m:int array array) ->

 let mm = float_of_matrix m in

  let d = float_slow_det mm in

   Util.round d ;;




(** 
int_invertibility threshold matrix
 *)


let int_invertibility = fun (threshold:float) (m:int array array) ->

 let mm = float_of_matrix m in

  if float_invertibility mm then

   begin

    let d = float_det mm in

     if abs_float ( (abs_float d) -. 1. ) < threshold then true else false

   end

  else false ;;




(** 
int_slow_invertibility threshold matrix
 *)


let int_slow_invertibility = fun (threshold:float) (m:int array array) ->

 let mm = float_of_matrix m in

  if float_slow_invertibility mm then

   begin

    let d = float_slow_det mm in

     if abs_float ( (abs_float d) -. 1. ) < threshold then true else false

   end

  else false ;;




(** 
int_inv matrix
 *)


let int_inv = function (m:int array array) ->

 if int_invertibility 0.5 m then

  begin

   let mm = float_of_matrix m in

    let mmm = matrix_float_scal_left_div (matrix_float_norm_inf mm) mm in

     matrix_float_round ( matrix_float_scal_left_div (matrix_float_norm_inf mm) (float_inv mmm) )

  end

 else failwith "Inversion error in Matrix.int_inv." ;;




(** 
int_slow_inv matrix
 *)


let int_slow_inv = function (m:int array array) ->

 if int_slow_invertibility 0.5 m then

  begin

   let mm = float_of_matrix m in

    let mmm = matrix_float_scal_left_div (matrix_float_norm_inf mm) mm in

     matrix_float_round ( matrix_float_scal_left_div (matrix_float_norm_inf mm) (float_slow_inv mmm) )

  end

 else failwith "Inversion error in Matrix.int_slow_inv." ;;




(** 
vector_float_reciprocal vector
 *)


let vector_float_reciprocal = function (v:float array) ->

 vector_float_scal_left_div ( vector_float_square_norm_2 v ) v ;;




(** 
matrix_float_reciprocal vector
 *)


let matrix_float_reciprocal = function (m:float array array) ->

 matrix_float_scal_left_div ( matrix_float_square_frobenius m ) m ;;




(** 
matrix_float_trans_reciprocal vector
 *)


let matrix_float_trans_reciprocal = function (m:float array array) ->

 matrix_float_scal_left_div ( matrix_float_square_frobenius m ) ( float_transpose m ) ;;










(** 
§ 
 *)



(** 

Accélérateurs de convergence ou compensateurs d'erreurs


Convergence Accelerators or error compensators

*)



(** 
 
 *)



(**

Suites dans float
---
Sequences of float
 

*)



(** 
 
 *)











(** 
float_aitken_seki u(n) u(n+1) u(n+2)
 *)


let float_aitken_seki = fun (a:float) (b:float) (c:float) ->

 let d = b -. a

 and e = c -. b in

  let f = d *. e

  and g = d -. e in

   let h = f /. g in

    b +. h ;;






(** 
float_aitken_seki_rec k n value_array
 *)


let rec float_aitken_seki_rec = fun (k:int) (n:int) (s:float array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.float_aitken_seki_rec." ;

 if n < 0 then failwith "Negative index of sequence in Matrix.float_aitken_seki_rec." ;

 if Array.length s <= n + 2 * k then failwith "Too short sequence in Matrix.float_aitken_seki_rec." ;

 match k with

 | 0 -> s.(n)

 | 1 -> float_aitken_seki s.(n) s.( n + 1 ) s.( n + 2 )

 | _ ->

  let kk = pred k in

   let a = float_aitken_seki_rec kk n s

   and b = float_aitken_seki_rec kk ( n + 1 ) s

   and c = float_aitken_seki_rec kk ( n + 2 ) s in

    if b -. a == 0. || c -. b == 0. || a -. c == 0. then c

    else float_aitken_seki a b c ;;






(** 
float_shanks2 u(n) u(n+1) u(n+2) u(n+3) u(n+4)
 *)


let float_shanks2 = fun (a:float) (b:float) (c:float) (d:float) (e:float) ->

 let delta0 = b -. a

 and delta1 = c -. b

 and delta2 = d -. c

 and delta3 = e -. d in

  let dd0 = delta1 -. delta0

  and dd1 = delta2 -. delta1

  and dd2 = delta3 -. delta2 in

   let denom = float_slow_det [| [| dd0 ; dd1 |] ; [| dd1 ; dd2 |] |]

   and numer = float_slow_det [| [| a ; b ; c |] ; [| b ; c ; d |] ; [| c ; d ; e |] |] in

    numer /. denom ;;






(** 
float_wynn k n value_array
 *)


let rec float_wynn = fun (k:int) (n:int) (s:float array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.float_wynn." ;

 let km1 = pred k

 and km2 = k - 2

 and np = succ n in

  match k with

  | -1 -> 0.

  | 0 ->

   begin

    if n < 0 then failwith "Negative index of sequence in Matrix.float_wynn." ;

    if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.float_wynn." ;

    s.(n)

   end

  | _ ->

   begin

    let a = float_wynn km2 np s

    and b = float_wynn km1 np s

    and c = float_wynn km1 n s in

     let d = b -. c in

      if d == 0. then b

      else a +. 1. /. d 

   end ;;






(** 
float_wynn_rho k n value_array
 *)


let rec float_wynn_rho = fun (k:int) (n:int) (s:float array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.float_wynn_rho." ;

  let km1 = pred k

  and km2 = k - 2

  and np = succ n in

   match k with

   | -1 -> 0.

   | 0 ->

    begin

     if n < 0 then failwith "Negative index of sequence in Matrix.float_wynn_rho." ;

     if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.float_wynn_rho." ;

     s.(n)

    end

   | _ ->

    begin

     let a = float_wynn_rho km2 np s

     and b = float_wynn_rho km1 np s

     and c = float_wynn_rho km1 n s in

      let d = b -. c in

      if d == 0. then b

      else a +. ( float k ) /. d

    end ;;






(** 
float_brezinski k n value_array
 *)


let rec float_brezinski = fun (k:int) (n:int) (s:float array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.float_brezinski." ;

 match k with

 | -1 -> 0.

 | 0 ->

  begin

   if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.float_brezinski." ;

   if n < 0 then failwith "Negative index of sequence in Matrix.float_brezinski." ;

   s.(n)

  end

 | _ ->

  begin

   let km1 = pred k

   and km2 = k - 2

   and np = succ n in

    match k mod 2 with

    | 1 ->

     begin

      let a = float_brezinski km2 np s

      and b = float_brezinski km1 np s

      and c = float_brezinski km1 n s in

       let d = b -. c in

        if d == 0. then b

        else a +. 1. /. d

     end

    | _ ->

     begin

      let a = float_brezinski km2 np s

      and np2 = succ np in

       let b = float_brezinski km1 np2 s

       and bb = float_brezinski km1 np s

       and c = float_brezinski km2 np2 s

       and cc = float_brezinski km2 np s in

        let d = b -. bb

        and dd = c -. cc in

         let ee = d *. dd

         and eee = ( float_brezinski km1 n s ) +. ( float_brezinski km1 np2 s ) in

          let eeee = eee -. ( 2. *. ( float_brezinski km1 np s ) ) in

           if eeee == 0. then b

           else a +. ee /. eeee

     end

  end ;;






(** 
float_approx value_array
 *)


let float_approx = function (s:float array) ->

 let rr = pred ( Array.length s ) in

  let kk = rr / 2

  and parity = rr mod 2 in

   if parity == 0 then ( float_aitken_seki_rec kk 0 s )

   else ( float_aitken_seki_rec kk 1 s ) ;;










(** 
§ 
 *)



(**

Suites de vecteurs
---
Vector sequences
 

*)



(** 
 
 *)











(** 
vector_float_aitken_seki u(n) u(n+1) u(n+2)
 *)


let vector_float_aitken_seki = fun (a:float array) (b:float array) (c:float array) ->

 let d = vector_float_minus b a

 and e = vector_float_minus c b in

  let f = vector_float_scal_prod d e

  and g = vector_float_minus d e in

   let h = vector_float_scal_mult f ( vector_float_reciprocal g ) in

    vector_float_plus b h ;;






(** 
vector_float_aitken_seki_rec k n value_array
 *)


let rec vector_float_aitken_seki_rec = fun (k:int) (n:int) (s:float array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.vector_float_aitken_seki_rec." ;

 if n < 0 then failwith "Negative index of sequence in Matrix.vector_float_aitken_seki_rec." ;

 if Array.length s <= n + 2 * k then failwith "Too short sequence in Matrix.vector_float_aitken_seki_rec." ;

 match k with

 | 0 -> s.(n)

 | 1 -> vector_float_aitken_seki s.(n) s.( n + 1 ) s.( n + 2 )

 | _ ->

  let kk = pred k in

   let a = vector_float_aitken_seki_rec kk n s

   and b = vector_float_aitken_seki_rec kk ( n + 1 ) s

   and c = vector_float_aitken_seki_rec kk ( n + 2 ) s in

    if vector_float_norm_inf ( vector_float_minus b a ) == 0. || vector_float_norm_inf ( vector_float_minus c b ) == 0. || vector_float_norm_inf ( vector_float_minus a c ) == 0. then c

    else vector_float_aitken_seki a b c ;;






(** 
vector_float_wynn k n value_array
 *)


let rec vector_float_wynn = fun (k:int) (n:int) (s:float array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.vector_float_wynn." ;

 let km1 = pred k

 and km2 = k - 2

 and np = succ n in

  match k with

  | -1 -> Array.make ( Array.length s.(0) ) 0.

  | 0 ->

   begin

    if n < 0 then failwith "Negative index of sequence in Matrix.vector_float_wynn." ;

    if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.vector_float_wynn." ;

    s.(n)

   end

  | _ ->

   begin

    let a = vector_float_wynn km2 np s

    and b = vector_float_wynn km1 np s

    and c = vector_float_wynn km1 n s in

     let d = vector_float_minus b c in

      if vector_float_norm_inf d == 0. then b

      else vector_float_plus a ( vector_float_reciprocal d )

   end ;;






(** 
vector_float_wynn_rho k n value_array
 *)


let rec vector_float_wynn_rho = fun (k:int) (n:int) (s:float array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.vector_float_wynn_rho." ;

  let km1 = pred k

  and km2 = k - 2

  and np = succ n in

   match k with

   | -1 -> Array.make ( Array.length s.(0) ) 0.

   | 0 ->

    begin

    if n < 0 then failwith "Negative index of sequence in Matrix.vector_float_wynn_rho." ;

    if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.vector_float_wynn_rho." ;

    s.(n)

    end

   | _ ->

    begin

     let a = vector_float_wynn_rho km2 np s

     and b = vector_float_wynn_rho km1 np s

     and c = vector_float_wynn_rho km1 n s in

      let d = vector_float_minus b c in

       if vector_float_norm_inf d == 0. then b

       else vector_float_plus a ( vector_float_scal_mult ( float k ) ( vector_float_reciprocal d ) )

    end ;;






(** 
vector_float_brezinski k n value_array
 *)


let rec vector_float_brezinski = fun (k:int) (n:int) (s:float array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.vector_float_brezinski." ;

 match k with

 | -1 -> Array.make ( Array.length s.(0) ) 0.

 | 0 ->

  begin

   if n < 0 then failwith "Negative index of sequence in Matrix.vector_float_brezinski." ;

   if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.vector_float_brezinski." ;

   s.(n)

  end

 | _ ->

  begin

   let km1 = pred k

   and km2 = k - 2

   and np = succ n in

    match k mod 2 with

    | 1 ->

     begin

      let a = vector_float_brezinski km2 np s

      and b = vector_float_brezinski km1 np s

      and c = vector_float_brezinski km1 n s in

       let d = vector_float_minus b c in

        if vector_float_norm_inf d == 0. then b

        else vector_float_plus a ( vector_float_reciprocal d )

     end

    | _ ->

     begin

      let a = vector_float_brezinski km2 np s

      and np2 = succ np in

       let b = vector_float_brezinski km1 np2 s

       and bb = vector_float_brezinski km1 np s

       and c = vector_float_brezinski km2 np2 s

       and cc = vector_float_brezinski km2 np s in

        let d = vector_float_minus b bb

        and dd = vector_float_minus c cc in

         let ee = vector_float_scal_prod d dd

         and eee = vector_float_plus ( vector_float_brezinski km1 n s ) ( vector_float_brezinski km1 np2 s ) in

          let eeee = vector_float_minus eee ( vector_float_scal_mult 2. ( vector_float_brezinski km1 np s ) ) in

           if vector_float_norm_inf eeee == 0. then b

           else vector_float_plus a ( vector_float_scal_mult ee ( vector_float_reciprocal eeee ) )

     end

  end ;;






(** 
vector_float_approx value_array
 *)


let vector_float_approx = function (s:float array array) ->

 let rr = pred ( Array.length s ) in

  let kk = rr / 2

  and parity = rr mod 2 in

   if parity == 0 then ( vector_float_aitken_seki_rec kk 0 s )

   else ( vector_float_aitken_seki_rec kk 1 s ) ;;






(** 
vector_float_approx_bis value_array
 *)


let vector_float_approx_bis = function (s:float array array) ->

 let rr = pred ( Array.length s ) in

  let kk = rr / 2

  and parity = rr mod 2 in

   if parity == 0 then ( vector_float_wynn ( 2 * kk ) 0 s )

   else ( vector_float_wynn ( 2 * kk ) 1 s ) ;;










(** 
§ 
 *)



(**

Suites de matrices
---
Matrix sequences
 

*)



(** 
 
 *)











(** 
matrix_float_aitken_seki_bis u(n) u(n+1) u(n+2)
 *)


let matrix_float_aitken_seki_bis = fun (a:float array array) (b:float array array) (c:float array array) ->

 let d = matrix_float_minus b a

 and e = matrix_float_minus c b in

  let g = matrix_float_minus d e in

   let h = matrix_float_triple_prod d ( float_transpose e ) ( matrix_float_reciprocal g ) in

    matrix_float_plus b h ;;






(** 
matrix_float_aitken_seki u(n) u(n+1) u(n+2)
 *)


let matrix_float_aitken_seki = fun (a:float array array) (b:float array array) (c:float array array) ->

 let d = matrix_float_minus b a

 and e = matrix_float_minus c b in

  let f = matrix_float_frobenius_prod d e 

  and g = matrix_float_minus d e in

   let h = matrix_float_scal_mult f ( matrix_float_reciprocal g ) in

    matrix_float_plus b ( float_transpose h ) ;;






(** 
matrix_trans_float_aitken_seki_bis u(n) u(n+1) u(n+2)
 *)


let matrix_trans_float_aitken_seki_bis = fun (a:float array array) (b:float array array) (c:float array array) ->

 let d = matrix_float_minus b a

 and e = matrix_float_minus c b in

  let g = matrix_float_minus d e in

   let h = matrix_float_triple_prod d ( float_transpose e ) ( matrix_float_trans_reciprocal g ) in

    matrix_float_plus b h ;;






(** 
matrix_trans_float_aitken_seki u(n) u(n+1) u(n+2)
 *)


let matrix_trans_float_aitken_seki = fun (a:float array array) (b:float array array) (c:float array array) ->

 let d = matrix_float_minus b a

 and e = matrix_float_minus c b in

  let f = matrix_float_frobenius_prod d e 

  and g = matrix_float_minus d e in

   let h = matrix_float_scal_mult f ( matrix_float_trans_reciprocal g ) in

    matrix_float_plus b ( float_transpose h ) ;;






(** 
matrix_float_aitken_seki_rec_bis k n value_array
 *)


let rec matrix_float_aitken_seki_rec_bis = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_float_aitken_seki_rec_bis." ;

 if n < 0 then failwith "Negative index of sequence in Matrix.matrix_float_aitken_seki_rec_bis." ;

 if Array.length s <= n + 2 * k then failwith "Too short sequence in Matrix.matrix_float_aitken_seki_rec_bis." ;

 match k with

 | 0 -> s.(n)

 | 1 -> matrix_float_aitken_seki_bis s.(n) s.( n + 1 ) s.( n + 2 )

 | _ ->

  let kk = pred k in

   let a = matrix_float_aitken_seki_rec_bis kk n s

   and b = matrix_float_aitken_seki_rec_bis kk ( n + 1 ) s

   and c = matrix_float_aitken_seki_rec_bis kk ( n + 2 ) s in

    if matrix_float_norm_inf ( matrix_float_minus b a ) == 0. || matrix_float_norm_inf ( matrix_float_minus c b ) == 0. || matrix_float_norm_inf ( matrix_float_minus a c ) == 0. then c

    else matrix_float_aitken_seki_bis a b c ;;






(** 
matrix_float_aitken_seki_rec k n value_array
 *)


let rec matrix_float_aitken_seki_rec = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_float_aitken_seki_rec." ;

 if n < 0 then failwith "Negative index of sequence in Matrix.matrix_float_aitken_seki_rec." ;

 if Array.length s <= n + 2 * k then failwith "Too short sequence in Matrix.matrix_float_aitken_seki_rec." ;

 match k with

 | 0 -> s.(n)

 | 1 -> matrix_float_aitken_seki s.(n) s.( n + 1 ) s.( n + 2 )

 | _ ->

  let kk = pred k in

   let a = matrix_float_aitken_seki_rec kk n s

   and b = matrix_float_aitken_seki_rec kk ( n + 1 ) s

   and c = matrix_float_aitken_seki_rec kk ( n + 2 ) s in

    if matrix_float_norm_inf ( matrix_float_minus b a ) == 0. || matrix_float_norm_inf ( matrix_float_minus c b ) == 0. || matrix_float_norm_inf ( matrix_float_minus a c ) == 0. then c

    else matrix_float_aitken_seki a b c ;;






(** 
matrix_trans_float_aitken_seki_rec_bis k n value_array
 *)


let rec matrix_trans_float_aitken_seki_rec_bis = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_trans_float_aitken_seki_rec_bis." ;

 if n < 0 then failwith "Negative index of sequence in Matrix.matrix_trans_float_aitken_seki_rec_bis." ;

 if Array.length s <= n + 2 * k then failwith "Too short sequence in Matrix.matrix_trans_float_aitken_seki_rec_bis." ;

 match k with

 | 0 -> s.(n)

 | 1 -> matrix_trans_float_aitken_seki_bis s.(n) s.( n + 1 ) s.( n + 2 )

 | _ ->

  let kk = pred k in

   let a = matrix_trans_float_aitken_seki_rec_bis kk n s

   and b = matrix_trans_float_aitken_seki_rec_bis kk ( n + 1 ) s

   and c = matrix_trans_float_aitken_seki_rec_bis kk ( n + 2 ) s in

    if matrix_float_norm_inf ( matrix_float_minus b a ) == 0. || matrix_float_norm_inf ( matrix_float_minus c b ) == 0. || matrix_float_norm_inf ( matrix_float_minus a c ) == 0. then c

    else matrix_trans_float_aitken_seki_bis a b c ;;






(** 
matrix_trans_float_aitken_seki_rec k n value_array
 *)


let rec matrix_trans_float_aitken_seki_rec = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_trans_float_aitken_seki_rec." ;

 if n < 0 then failwith "Negative index of sequence in Matrix.matrix_trans_float_aitken_seki_rec." ;

 if Array.length s <= n + 2 * k then failwith "Too short sequence in Matrix.matrix_trans_float_aitken_seki_rec." ;

 match k with

 | 0 -> s.(n)

 | 1 -> matrix_trans_float_aitken_seki s.(n) s.( n + 1 ) s.( n + 2 )

 | _ ->

  let kk = pred k in

   let a = matrix_trans_float_aitken_seki_rec kk n s

   and b = matrix_trans_float_aitken_seki_rec kk ( n + 1 ) s

   and c = matrix_trans_float_aitken_seki_rec kk ( n + 2 ) s in

    if matrix_float_norm_inf ( matrix_float_minus b a ) == 0. || matrix_float_norm_inf ( matrix_float_minus c b ) == 0. || matrix_float_norm_inf ( matrix_float_minus a c ) == 0. then c

    else matrix_trans_float_aitken_seki a b c ;;






(** 
matrix_float_wynn k n value_array
 *)


let rec matrix_float_wynn = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_float_wynn." ;

 let km1 = pred k

 and km2 = k - 2

 and np = succ n in

  match k with

  | -1 -> Array.make_matrix ( Array.length s.(0) ) ( Array.length s.(0).(0) ) 0.

  | 0 ->

   begin

    if n < 0 then failwith "Negative index of sequence in Matrix.matrix_float_wynn." ;

    if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.matrix_float_wynn." ;

    s.(n)

   end

  | _ ->

   begin

    let a = matrix_float_wynn km2 np s

    and b = matrix_float_wynn km1 np s

    and c = matrix_float_wynn km1 n s in

     let d = matrix_float_minus b c in

      if matrix_float_norm_inf d == 0. then b

      else matrix_float_plus a ( matrix_float_reciprocal d )

   end ;;






(** 
matrix_trans_float_wynn k n value_array
 *)


let rec matrix_trans_float_wynn = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_trans_float_wynn." ;

 let km1 = pred k

 and km2 = k - 2

 and np = succ n in

  match k with

  | -1 -> Array.make_matrix ( Array.length s.(0) ) ( Array.length s.(0).(0) ) 0.

  | 0 ->

   begin

    if n < 0 then failwith "Negative index of sequence in Matrix.matrix_trans_float_wynn." ;

    if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.matrix_trans_float_wynn." ;

    s.(n)

   end

  | _ ->

   begin

    let a = matrix_trans_float_wynn km2 np s

    and b = matrix_trans_float_wynn km1 np s

    and c = matrix_trans_float_wynn km1 n s in

     let d = matrix_float_minus b c in

      if matrix_float_norm_inf d == 0. then b

      else matrix_float_plus a ( matrix_float_trans_reciprocal d )

   end ;;






(** 
matrix_float_wynn_rho k n value_array
 *)


let rec matrix_float_wynn_rho = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_float_wynn_rho." ;

  let km1 = pred k

  and km2 = k - 2

  and np = succ n in

   match k with

   | -1 -> Array.make_matrix ( Array.length s.(0) ) ( Array.length s.(0).(0) ) 0.

   | 0 ->

    begin

     if n < 0 then failwith "Negative index of sequence in Matrix.matrix_float_wynn_rho." ;

     if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.matrix_float_wynn_rho." ;

     s.(n)

    end

   | _ ->

    begin

     let a = matrix_float_wynn_rho km2 np s

     and b = matrix_float_wynn_rho km1 np s

     and c = matrix_float_wynn_rho km1 n s in

      let d = matrix_float_minus b c in

      if matrix_float_norm_inf d == 0. then b

      else matrix_float_plus a ( matrix_float_scal_mult ( float k ) ( matrix_float_reciprocal d ) )

    end ;;






(** 
matrix_trans_float_wynn_rho k n value_array
 *)


let rec matrix_trans_float_wynn_rho = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_trans_float_wynn_rho." ;

  let km1 = pred k

  and km2 = k - 2

  and np = succ n in

   match k with

   | -1 -> Array.make_matrix ( Array.length s.(0) ) ( Array.length s.(0).(0) ) 0.

   | 0 ->

    begin

     if n < 0 then failwith "Negative index of sequence in Matrix.matrix_trans_float_wynn_rho." ;

     if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.matrix_trans_float_wynn_rho." ;

     s.(n)

    end

   | _ ->

    begin

     let a = matrix_trans_float_wynn_rho km2 np s

     and b = matrix_trans_float_wynn_rho km1 np s

     and c = matrix_trans_float_wynn_rho km1 n s in

      let d = matrix_float_minus b c in

      if matrix_float_norm_inf d == 0. then b

      else matrix_float_plus a ( matrix_float_scal_mult ( float k ) ( matrix_float_trans_reciprocal d ) )

    end ;;






(** 
matrix_float_brezinski_bis k n value_array
 *)


let rec matrix_float_brezinski_bis = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_float_brezinski_bis." ;

 match k with

 | -1 -> Array.make_matrix ( Array.length s.(0) ) ( Array.length s.(0).(0) ) 0.

 | 0 ->

  begin

   if n < 0 then failwith "Negative index of sequence in Matrix.matrix_float_brezinski_bis." ;

   if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.matrix_float_brezinski_bis." ;

   s.(n)

  end

 | _ ->

  begin

   let km1 = pred k

   and km2 = k - 2

   and np = succ n in

    match k mod 2 with

    | 1 ->

     begin

      let a = matrix_float_brezinski_bis km2 np s

      and b = matrix_float_brezinski_bis km1 np s

      and c = matrix_float_brezinski_bis km1 n s in

       let d = matrix_float_minus b c in

        if matrix_float_norm_inf d == 0. then b

        else matrix_float_plus a ( matrix_float_reciprocal d )

     end

    | _ ->

     begin

      let a = matrix_float_brezinski_bis km2 np s

      and np2 = succ np in

       let b = matrix_float_brezinski_bis km1 np2 s

       and bb = matrix_float_brezinski_bis km1 np s

       and c = matrix_float_brezinski_bis km2 np2 s

       and cc = matrix_float_brezinski_bis km2 np s in

        let d = matrix_float_minus b bb

        and dd = matrix_float_minus c cc in

         let eee = matrix_float_plus ( matrix_float_brezinski_bis km1 n s ) ( matrix_float_brezinski_bis km1 np2 s ) in

          let eeee = matrix_float_minus eee ( matrix_float_scal_mult 2. ( matrix_float_brezinski_bis km1 np s ) ) in

           if matrix_float_norm_inf eeee == 0. then b

           else matrix_float_plus a ( matrix_float_triple_prod ( float_transpose d ) dd ( matrix_float_reciprocal eeee ) )

     end

  end ;;






(** 
matrix_trans_float_brezinski_bis k n value_array
 *)


let rec matrix_trans_float_brezinski_bis = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_trans_float_brezinski_bis." ;

 match k with

 | -1 -> Array.make_matrix ( Array.length s.(0) ) ( Array.length s.(0).(0) ) 0.

 | 0 ->

  begin

   if n < 0 then failwith "Negative index of sequence in Matrix.matrix_trans_float_brezinski_bis." ;

   if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.matrix_trans_float_brezinski_bis." ;

   s.(n)

  end

 | _ ->

  begin

   let km1 = pred k

   and km2 = k - 2

   and np = succ n in

    match k mod 2 with

    | 1 ->

     begin

      let a = matrix_trans_float_brezinski_bis km2 np s

      and b = matrix_trans_float_brezinski_bis km1 np s

      and c = matrix_trans_float_brezinski_bis km1 n s in

       let d = matrix_float_minus b c in

        if matrix_float_norm_inf d == 0. then b

        else matrix_float_plus a ( matrix_float_trans_reciprocal d )

     end

    | _ ->

     begin

      let a = matrix_trans_float_brezinski_bis km2 np s

      and np2 = succ np in

       let b = matrix_trans_float_brezinski_bis km1 np2 s

       and bb = matrix_trans_float_brezinski_bis km1 np s

       and c = matrix_trans_float_brezinski_bis km2 np2 s

       and cc = matrix_trans_float_brezinski_bis km2 np s in

        let d = matrix_float_minus b bb

        and dd = matrix_float_minus c cc in

         let eee = matrix_float_plus ( matrix_trans_float_brezinski_bis km1 n s ) ( matrix_trans_float_brezinski_bis km1 np2 s ) in

          let eeee = matrix_float_minus eee ( matrix_float_scal_mult 2. ( matrix_trans_float_brezinski_bis km1 np s ) ) in

           if matrix_float_norm_inf eeee == 0. then b

           else matrix_float_plus a ( matrix_float_triple_prod ( float_transpose d ) dd ( matrix_float_trans_reciprocal eeee ) )

     end

  end ;;






(** 
matrix_float_brezinski k n value_array
 *)


let rec matrix_float_brezinski = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_float_brezinski." ;

 match k with

 | -1 -> Array.make_matrix ( Array.length s.(0) ) ( Array.length s.(0).(0) ) 0.

 | 0 ->

  begin

   if n < 0 then failwith "Negative index of sequence in Matrix.matrix_float_brezinski." ;

   if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.matrix_float_brezinski." ;

   s.(n)

  end

 | _ ->

  begin

   let km1 = pred k

   and km2 = k - 2

   and np = succ n in

    match k mod 2 with

    | 1 ->

     begin

      let a = matrix_float_brezinski km2 np s

      and b = matrix_float_brezinski km1 np s

      and c = matrix_float_brezinski km1 n s in

       let d = matrix_float_minus b c in

        if matrix_float_norm_inf d == 0. then b

        else matrix_float_plus a ( matrix_float_reciprocal d )

     end

    | _ ->

     begin

      let a = matrix_float_brezinski km2 np s

      and np2 = succ np in

       let b = matrix_float_brezinski km1 np2 s

       and bb = matrix_float_brezinski km1 np s

       and c = matrix_float_brezinski km2 np2 s

       and cc = matrix_float_brezinski km2 np s in

        let d = matrix_float_minus b bb

        and dd = matrix_float_minus c cc in

         let ee = matrix_float_frobenius_prod d dd

         and eee = matrix_float_plus ( matrix_float_brezinski km1 n s ) ( matrix_float_brezinski km1 np2 s ) in

          let eeee = matrix_float_minus eee ( matrix_float_scal_mult 2. ( matrix_float_brezinski km1 np s ) ) in

           if matrix_float_norm_inf eeee == 0. then b

           else matrix_float_plus a ( matrix_float_scal_mult ee ( matrix_float_reciprocal eeee ) )

     end

  end ;;






(** 
matrix_trans_float_brezinski k n value_array
 *)


let rec matrix_trans_float_brezinski = fun (k:int) (n:int) (s:float array array array) ->

 if k < -1 then failwith "Needed k >= -1 in Matrix.matrix_trans_float_brezinski." ;

 match k with

 | -1 -> Array.make_matrix ( Array.length s.(0) ) ( Array.length s.(0).(0) ) 0.

 | 0 ->

  begin

   if n < 0 then failwith "Negative index of sequence in Matrix.matrix_trans_float_brezinski." ;

   if n > pred ( Array.length s ) then failwith "Too short sequence in Matrix.matrix_trans_float_brezinski." ;

   s.(n)

  end

 | _ ->

  begin

   let km1 = pred k

   and km2 = k - 2

   and np = succ n in

    match k mod 2 with

    | 1 ->

     begin

      let a = matrix_trans_float_brezinski km2 np s

      and b = matrix_trans_float_brezinski km1 np s

      and c = matrix_trans_float_brezinski km1 n s in

       let d = matrix_float_minus b c in

        if matrix_float_norm_inf d == 0. then b

        else matrix_float_plus a ( matrix_float_trans_reciprocal d )

     end

    | _ ->

     begin

      let a = matrix_trans_float_brezinski km2 np s

      and np2 = succ np in

       let b = matrix_trans_float_brezinski km1 np2 s

       and bb = matrix_trans_float_brezinski km1 np s

       and c = matrix_trans_float_brezinski km2 np2 s

       and cc = matrix_trans_float_brezinski km2 np s in

        let d = matrix_float_minus b bb

        and dd = matrix_float_minus c cc in

         let ee = matrix_float_frobenius_prod d dd

         and eee = matrix_float_plus ( matrix_trans_float_brezinski km1 n s ) ( matrix_trans_float_brezinski km1 np2 s ) in

          let eeee = matrix_float_minus eee ( matrix_float_scal_mult 2. ( matrix_trans_float_brezinski km1 np s ) ) in

           if matrix_float_norm_inf eeee == 0. then b

           else matrix_float_plus a ( matrix_float_scal_mult ee ( matrix_float_trans_reciprocal eeee ) )

     end

  end ;;






(** 
matrix_float_approx_bis value_array
 *)


let matrix_float_approx_bis = function (s:float array array array) ->

 let rr = pred ( Array.length s ) in

  let kk = rr / 2

  and parity = rr mod 2 in

   if parity == 0 then ( matrix_float_wynn kk 0 s )

   else ( matrix_float_wynn kk 1 s ) ;;






(** 
matrix_float_approx value_array
 *)


let matrix_float_approx = function (s:float array array array) ->

 let rr = pred ( Array.length s ) in

  let kk = rr / 2

  and parity = rr mod 2 in

   if parity == 0 then ( matrix_float_aitken_seki_rec kk 0 s )

   else ( matrix_float_aitken_seki_rec kk 1 s ) ;;






(** 
matrix_trans_float_approx_bis value_array
 *)


let matrix_trans_float_approx_bis = function (s:float array array array) ->

 let rr = pred ( Array.length s ) in

  let kk = rr / 2

  and parity = rr mod 2 in

   if parity == 0 then ( matrix_trans_float_wynn kk 0 s )

   else ( matrix_trans_float_wynn kk 1 s ) ;;






(** 
matrix_trans_float_approx value_array
 *)


let matrix_trans_float_approx = function (s:float array array array) ->

 let rr = pred ( Array.length s ) in

  let kk = rr / 2

  and parity = rr mod 2 in

   if parity == 0 then ( matrix_trans_float_aitken_seki_rec kk 0 s )

   else ( matrix_trans_float_aitken_seki_rec kk 1 s ) ;;










(** 
§ 
 *)



(**

Calcul sur les matrices par blocs


Calculus on block matrices

*)



(** 
 
 *)



(**

Définitions et échanges
---
Definitions and exchanges
 

*)



(** 
 
 *)











(** The float_or_array recursive type is used to collect real numbers, real vectors, real matrices, and the corresponding block matrices.



Le type récursif float_or_array sert à réunir nombres réels, vecteurs réels et matrices réelles avec les matrices par blocs correspondantes. *)


type float_or_array = 

   Empty

 | Float_cons of float 

 | Float_vector_cons of float array

 | Float_matrix_cons of float array array

 | Foa_vector_cons of float_or_array array

 | Foa_matrix_cons of float_or_array array array ;;






(** 
vector_foa_copy vector
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_copy = function (v:float_or_array) ->

 match v with

 | Float_cons x -> Float_cons ( 0. +. x )

 | Float_vector_cons x ->

  let vv = vector_float_copy x in

   Float_vector_cons vv

 | Foa_vector_cons x ->

  let r = Array.length x in

   let vvv = Array.make r (Float_cons 0.) in

    for i = 0 to r - 1 do

     vvv.(i) <- vector_foa_copy x.(i)

    done ;

    Foa_vector_cons vvv

 | _ -> Float_cons 0. ;;






(** 
vector_foa_eq vector1 vector2
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_eq = fun (v:float_or_array) (w:float_or_array) ->

 match v with

 | Float_cons x ->

  begin

   match w with

   | Float_cons y -> x = y

   | _ -> false

  end

 | Float_vector_cons x ->

  begin

   match w with

   | Float_vector_cons y -> Util.array_eq ( = ) x y

   | _ -> false

  end

 | Foa_vector_cons x ->

  begin

   match w with

   | Foa_vector_cons y -> Util.array_eq vector_foa_eq x y

   | _ -> false

  end

 | _ -> false ;;






(** 
matrix_foa_copy matrix
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec matrix_foa_copy = function (m:float_or_array) ->

 match m with

 | Float_cons y -> Float_cons ( 0. +. y )

 | Float_matrix_cons y -> Float_matrix_cons ( matrix_float_copy y)

 | Foa_matrix_cons y ->

  let r = numrows y

  and cc = (numcolumns y) - 1 in

   let m_m = Array.make_matrix r (cc + 1) (Float_cons 0.) in

    for i = 0 to r - 1 do

     for j = 0 to cc do

      m_m.(i).(j) <- matrix_foa_copy y.(i).(j)

     done

    done ;

    Foa_matrix_cons m_m

 | _ -> Float_cons 0. ;;






(** 
float_demakeup coefficient
 *)


let float_demakeup = function (x:float_or_array) ->

 match x with

 | (Float_cons y) -> 0. +. y 

 | _ -> failwith "Bad type Float_cons in Matrix.float_demakeup." ;;




(** 
vector_float_demakeup vector
 *)


let vector_float_demakeup = function (x:float_or_array) ->

 match x with

 | (Float_vector_cons y) -> vector_float_copy y

 | _ -> failwith "Bad type Float_vector_cons in Matrix.vector_float_demakeup." ;;




(** 
matrix_float_demakeup matrix
 *)


let matrix_float_demakeup = function (x:float_or_array) ->

 match x with

 | (Float_matrix_cons y) -> matrix_float_copy y

 | _ -> failwith "Bad type Float_matrix_cons in Matrix.matrix_float_demakeup." ;;




(** 
vector_foa_demakeup vector
 *)


let vector_foa_demakeup = function (x:float_or_array) ->

 match x with

 | (Foa_vector_cons y) ->

  begin

   let r = Array.length y in

    let vvv = Array.make r (Float_cons 0.) in

     for i = 0 to r - 1 do

      vvv.(i) <- vector_foa_copy y.(i)

     done ;

     vvv

  end

 | _ -> failwith "Bad type Foa_vector_cons in Matrix.vector_foa_demakeup." ;;




(** 
matrix_foa_demakeup matrix
 *)


let matrix_foa_demakeup = function (x:float_or_array) ->

 match x with

 | (Foa_matrix_cons y) ->

  begin

   let r = numrows y

   and cc = (numcolumns y) - 1 in

    let m_m = Array.make_matrix r (cc + 1) (Float_cons 0.) in

     for i = 0 to r - 1 do

      for j = 0 to cc do

       m_m.(i).(j) <- matrix_foa_copy y.(i).(j)

      done

     done ;

     m_m

  end

 | _ -> failwith "Bad type Foa_matrix_cons in Matrix.matrix_foa_demakeup." ;;




(** 
foa_thickness coefficient-or-vector-or-matrix
 *)


let rec foa_thickness = function (x:float_or_array) ->

 match x with

 | (Float_cons y) -> 0

 | (Float_vector_cons y) -> 0

 | (Float_matrix_cons y) -> 0 

 | (Foa_vector_cons y) ->

  begin

   let accu = ref 0 in

    for i = 0 to (Array.length y) - 1 do

     let x = foa_thickness y.(i) in

      if x > !accu then accu := x

    done ;

    1 + !accu

  end

 | (Foa_matrix_cons y) ->

  begin

   let accu = ref 0 in

    for i = 0 to (Array.length y) - 1 do

     let row = y.(i) in

      for j = 0 to (Array.length row) - 1 do

       let x = foa_thickness row.(j) in

        if x > !accu then accu := x

      done

    done ;

    1 + !accu

  end

 | _ -> 0 ;;






(** The int_or_array recursive type is used to collect integer numbers, integer vectors, integer matrices, and the corresponding block matrices.



Le type récursif int_or_array sert à réunir nombres entiers, vecteurs entiers et matrices entières avec les matrices par blocs correspondantes. *)


type int_or_array = 

   Empty

 | Int_cons of int 

 | Int_vector_cons of int array

 | Int_matrix_cons of int array array

 | Ioa_vector_cons of int_or_array array

 | Ioa_matrix_cons of int_or_array array array  ;;






(** 
vector_ioa_copy vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_copy = function (v:int_or_array) ->

 match v with

 | Int_cons x -> Int_cons ( 0 + x )

 | Int_vector_cons x ->

  let vv = vector_int_copy x in

   Int_vector_cons vv

 | Ioa_vector_cons x ->

  let r = Array.length x in

   let vvv = Array.make r (Int_cons 0) in

    for i = 0 to r - 1 do

     vvv.(i) <- vector_ioa_copy x.(i)

    done ;

    Ioa_vector_cons vvv

 | _ -> Int_cons 0 ;;






(** 
matrix_ioa_copy matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_copy = function (m:int_or_array) ->

 match m with

 | Int_cons y -> Int_cons ( 0 + y )

 | Int_matrix_cons y -> Int_matrix_cons ( matrix_int_copy y)

 | Ioa_matrix_cons y ->

  let r = numrows y

  and cc = (numcolumns y) - 1 in

   let m_m = Array.make_matrix r (cc + 1) (Int_cons 0) in

    for i = 0 to r - 1 do

     for j = 0 to cc do

      m_m.(i).(j) <- matrix_ioa_copy y.(i).(j)

     done

    done ;

    Ioa_matrix_cons m_m

 | _ -> Int_cons 0 ;;




(** 
int_demakeup coefficient
 *)


let int_demakeup = function (x:int_or_array) ->

 match x with

 | (Int_cons y) -> 0 + y 

 | _ -> failwith "Bad type Int_cons in Matrix.int_demakeup." ;;




(** 
vector_int_demakeup vector
 *)


let vector_int_demakeup = function (x:int_or_array) ->

 match x with

 | (Int_vector_cons y) -> vector_int_copy y

 | _ -> failwith "Bad type Int_vector_cons in Matrix.vector_int_demakeup." ;;




(** 
matrix_int_demakeup matrix
 *)


let matrix_int_demakeup = function (x:int_or_array) ->

 match x with

 | (Int_matrix_cons y) -> matrix_int_copy y

 | _ -> failwith "Bad type Int_matrix_cons in Matrix.matrix_int_demakeup." ;;




(** 
vector_ioa_demakeup vector
 *)


let vector_ioa_demakeup = function (x:int_or_array) ->

 match x with

 | (Ioa_vector_cons y) ->

  begin

   let r = Array.length y in

    let vvv = Array.make r (Int_cons 0) in

     for i = 0 to r - 1 do

      vvv.(i) <- vector_ioa_copy y.(i)

     done ;

     vvv

  end

 | _ -> failwith "Bad type Ioa_vector_cons in Matrix.vector_ioa_demakeup." ;;




(** 
matrix_ioa_demakeup matrix
 *)


let matrix_ioa_demakeup = function (x:int_or_array) ->

 match x with

 | (Ioa_matrix_cons y) ->

  begin

   let r = numrows y

   and cc = (numcolumns y) - 1 in

    let m_m = Array.make_matrix r (cc + 1) (Int_cons 0) in

     for i = 0 to r - 1 do

      for j = 0 to cc do

       m_m.(i).(j) <- matrix_ioa_copy y.(i).(j)

      done

     done ;

     m_m

  end

 | _ -> failwith "Bad type Ioa_matrix_cons in Matrix.matrix_ioa_demakeup." ;;






(** 
ioa_thickness coefficient-or-vector-or-matrix
 *)


let rec ioa_thickness = function (x:int_or_array) ->

 match x with

 | (Int_cons y) -> 0

 | (Int_vector_cons y) -> 0

 | (Int_matrix_cons y) -> 0 

 | (Ioa_vector_cons y) ->

  begin

   let accu = ref 0 in

    for i = 0 to (Array.length y) - 1 do

     let x = ioa_thickness y.(i) in

      if x > !accu then accu := x

    done ;

    1 + !accu

  end

 | (Ioa_matrix_cons y) ->

  begin

   let accu = ref 0 in

    for i = 0 to (Array.length y) - 1 do

     let row = y.(i) in

      for j = 0 to (Array.length row) - 1 do

       let x = ioa_thickness row.(j) in

        if x > !accu then accu := x

      done

    done ;

    1 + !accu

  end

 | _ -> 0 ;;






(** 
foa_of_ioa integer_or_array
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec foa_of_ioa = function (x:int_or_array) ->

 match x with

 | Int_cons y -> Float_cons (float_of_int y)

 | Int_vector_cons v -> Float_vector_cons ( float_of_vector v ) 

 | Ioa_vector_cons z ->

  begin

   let r = Array.length z in

    let ww = Array.make r (Float_cons 0.) in

     for i = 0 to r - 1 do

      ww.(i) <- foa_of_ioa z.(i)

     done ;

     Foa_vector_cons ww

  end

 | Int_matrix_cons m -> Float_matrix_cons ( float_of_matrix m ) 

 | Ioa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = Array.length w.(0) - 1 in

    let ww = Array.make_matrix r (cc + 1) (Float_cons 0.) in

     for i = 0 to r - 1 do

      let row_input = w.(i)

      and row_output = ww.(i) in

       for j = 0 to cc do

        row_output.(j) <- foa_of_ioa ( row_input.(j) )

       done

     done ;

     Foa_matrix_cons ww

  end

 | _ -> failwith "Not an integer_or_array in Matrix.foa_of_ioa." ;;






(** 
ioa_of_foa float_or_array
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec ioa_of_foa = function (x:float_or_array) ->

 match x with

 | Float_cons y -> Int_cons (int_of_float y)

 | Float_vector_cons v -> Int_vector_cons ( int_of_vector v ) 

 | Foa_vector_cons z ->

  begin

   let r = Array.length z in

    let ww = Array.make r (Int_cons 0) in

     for i = 0 to r - 1 do

      ww.(i) <- ioa_of_foa z.(i)

     done ;

     Ioa_vector_cons ww

  end

 | Float_matrix_cons m -> Int_matrix_cons ( int_of_matrix m )

 | Foa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = Array.length w.(0) - 1 in

    let ww = Array.make_matrix r (cc + 1) (Int_cons 0) in

     for i = 0 to r - 1 do

      let row_input = w.(i)

      and row_output = ww.(i) in

       for j = 0 to cc do

        row_output.(j) <- ioa_of_foa ( row_input.(j) )

       done

     done ;

     Ioa_matrix_cons ww

  end

 | _ -> failwith "Not a float_or_array in Matrix.ioa_of_foa." ;;






(** 
foa_apply float_or_array
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec foa_apply = fun (f:float -> float) (x:float_or_array) ->

match x with

 | Float_cons y -> Float_cons (f y)

 | Float_vector_cons v -> Float_vector_cons ( Array.map f v ) 

 | Foa_vector_cons z ->

  begin

   let r = Array.length z in

    let ww = Array.make r (Float_cons 0.) in

     for i = 0 to r - 1 do

      ww.(i) <- foa_apply f z.(i)

     done ;

     Foa_vector_cons ww

  end

 | Float_matrix_cons m -> Float_matrix_cons ( matrix_float_apply f m )

 | Foa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = Array.length w.(0) - 1 in

    let ww = Array.make_matrix r (cc + 1) (Float_cons 0.) in

     for i = 0 to r - 1 do

      let row_input = w.(i)

      and row_output = ww.(i) in

       for j = 0 to cc do

        row_output.(j) <- foa_apply f ( row_input.(j) )

       done

     done ;

     Foa_matrix_cons ww

  end

 | _ -> failwith "Not a float_or_array in Matrix.foa_apply." ;;






(** The type foa_strip is used for diagonal multiplication and Gauss pivot.



Le type foa_strip sert pour la multiplication diagonale et le pivot de Gauss. *)


type foa_strip = 

   Empty

 | Foa_cons of float_or_array

 | Foa_strip_cons of float_or_array array ;;




(** 
foa_strip_demakeup block-element
 *)


let foa_strip_demakeup = function (x:foa_strip) ->

 match x with

 | (Foa_cons y) -> let z = ref y in !z

 | _ -> failwith "Bad type Foa_cons in Matrix.foa_strip_demakeup." ;;




(** 
vector_foa_strip_demakeup block-vector
 *)


let vector_foa_strip_demakeup = function (x:foa_strip) ->

 match x with

 | (Foa_strip_cons y) -> let z = ref y in !z

 | _ -> failwith "Bad type Foa_strip_cons in Matrix.vector_foa_strip_demakeup." ;;






(** The type ioa_strip is used for diagonal multiplication.



Le type ioa_strip sert pour la multiplication diagonale. *)


type ioa_strip = 

   Empty

 | Ioa_cons of int_or_array

 | Ioa_strip_cons of int_or_array array ;;




(** 
ioa_strip_demakeup block-element
 *)


let ioa_strip_demakeup = function (x:ioa_strip) ->

 match x with

 | (Ioa_cons y) -> let z = ref y in !z

 | _ -> failwith "Bad type Ioa_cons in Matrix.ioa_strip_demakeup." ;;




(** 
vector_ioa_strip_demakeup block-vector
 *)


let vector_ioa_strip_demakeup = function (x:ioa_strip) ->

 match x with

 | (Ioa_strip_cons y) -> let z = ref y in !z

 | _ -> failwith "Bad type Ioa_strip_cons in Matrix.vector_ioa_strip_demakeup." ;;










(** 
§ 
 *)



(**

Constructions minimales pour les matrices par blocs
---
Minimal constructions for block matrices
 

*)



(** 
 
 *)



(**

 ++++++ Pasting and cutting, numbers of rows and columns.



Collage et découpage, nombres de lignes et de colonnes. ++++++ 

*)



(** 
 
 *)











(** 
vector_foa_cut parts vector
 *)


let vector_foa_cut = fun n (v:float_or_array) ->

 if n <= 1 then v else

  match v with

   | Float_vector_cons y  ->

     let r = Array.length y in

      if r < n then failwith "Too short in Matrix.vector_foa_cut."

      else

       let k = r / n in

        let vv = Array.make n (Float_cons 0.) in

         for i = 0 to n-2 do 

          vv.(i) <- Float_vector_cons ( Array.sub y (k*i) (k) )

         done ;

         vv.(n - 1) <- Float_vector_cons ( Array.sub y (k*(n - 1)) (r-k*(n - 1)) ) ;

         Foa_vector_cons vv 

   | Foa_vector_cons w ->

     let r = Array.length w in

      if r < n then failwith "Too short in Matrix.vector_foa_cut."

      else

       let k = r / n in

        let vv = Array.make n (Float_cons 0.) in

         for i = 0 to n-2 do 

          vv.(i) <- Foa_vector_cons ( Array.sub w (k*i) (k) )

         done ;

         vv.(n - 1) <- Foa_vector_cons ( Array.sub w (k*(n - 1)) (r-k*(n - 1)) ) ;

         Foa_vector_cons vv

   | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_cut." ;;




(** 
vector_foa_paste vector
 *)


let vector_foa_paste = function (v:float_or_array) ->

 match (foa_thickness v) with

  | 0 ->

   v

  | 1 ->

   let vv = vector_foa_demakeup v in

    let vvv = Array.map vector_float_demakeup vv in

     let vvvv = Array.to_list vvv in

      Float_vector_cons (Array.concat vvvv) 

  | _ ->

   let vv = vector_foa_demakeup v in

    let vvv = Array.map vector_foa_demakeup vv in

     let vvvv = Array.to_list vvv in

      Foa_vector_cons (Array.concat vvvv) ;;






(** 
vector_ioa_cut parts vector
 *)


let vector_ioa_cut = fun n (v:int_or_array) ->

 if n <= 1 then v else

  match (ioa_thickness v) with

   | 0 ->

    let w = vector_int_demakeup v in

     let r = Array.length w in

      if r < n then failwith "Too short in Matrix.vector_ioa_cut."

      else

       let k = r / n in

        let vv = Array.make n (Int_cons 0) in

         for i = 0 to n-2 do 

          vv.(i) <- Int_vector_cons ( Array.sub w (k*i) (k) )

         done ;

         vv.(n - 1) <- Int_vector_cons ( Array.sub w (k*(n - 1)) (r-k*(n - 1)) ) ;

         Ioa_vector_cons vv 

   | _ ->

    let w = vector_ioa_demakeup v in

     let r = Array.length w in

      if r < n then failwith "Too short in Matrix.vector_ioa_cut."

      else

       let k = r / n in

        let vv = Array.make n (Int_cons 0) in

         for i = 0 to n-2 do 

          vv.(i) <- Ioa_vector_cons ( Array.sub w (k*i) (k) )

         done ;

         vv.(n - 1) <- Ioa_vector_cons ( Array.sub w (k*(n - 1)) (r-k*(n - 1)) ) ;

         Ioa_vector_cons vv ;;




(** 
vector_ioa_paste vector
 *)


let vector_ioa_paste = function (v:int_or_array) ->

 match (ioa_thickness v) with

  | 0 ->

   v

  | 1 ->

   let vv = vector_ioa_demakeup v in

    let vvv = Array.map vector_int_demakeup vv in

     let vvvv = Array.to_list vvv in

      Int_vector_cons (Array.concat vvvv) 

  | _ ->

   let vv = vector_ioa_demakeup v in

    let vvv = Array.map vector_ioa_demakeup vv in

     let vvvv = Array.to_list vvv in

      Ioa_vector_cons (Array.concat vvvv) ;;






(** 
foa_numrows matrix
 *)


let foa_numrows = function (m:float_or_array) ->

 match (foa_thickness m) with

 | 0 -> numrows (matrix_float_demakeup m)

 | _ -> numrows (matrix_foa_demakeup m) ;;




(** 
foa_numcolumns matrix
 *)


let foa_numcolumns = function (m:float_or_array) ->

 match (foa_thickness m) with

 | 0 -> numcolumns (matrix_float_demakeup m)

 | _ -> numcolumns (matrix_foa_demakeup m) ;;






(** 
ioa_numrows matrix
 *)


let ioa_numrows = function (m:int_or_array) ->

 match (ioa_thickness m) with

 | 0 -> numrows (matrix_int_demakeup m)

 | _ -> numrows (matrix_ioa_demakeup m) ;;




(** 
ioa_numcolumns matrix
 *)


let ioa_numcolumns = function (m:int_or_array) ->

 match (ioa_thickness m) with

 | 0 -> numcolumns (matrix_int_demakeup m)

 | _ -> numcolumns (matrix_ioa_demakeup m) ;;






(** 
matrix_float_cut parts matrix
 *)


let matrix_float_cut = fun (n:int) (w:float array array) ->

 if n <= 1 then [| Float_matrix_cons w ; Foa_vector_cons ( [| Float_vector_cons [| 0. ; 0. |] |] ) |] else

  let r = Array.length w

  and c = numcolumns w in

   let pg = Util.int_max r c in

    let k = int_of_float ( ceil ( (float pg) /. (float n) ) ) in

     let kk = k * n in

      let rr = kk - r

      and cc = kk - c

      and nn = n - 1 in

       let m = Array.make_matrix kk kk 0. in

        for i = 0 to r - 1 do

         let row_output = m.(i)

         and row_input = w.(i) in

          Array.blit row_input 0 row_output 0 c

        done ;

        if (rr > 0) or (cc > 0) then 

         begin

          for i = ( min r c) to kk - 1 do

           m.(i).(i) <- 1.

          done

         end ;

        let k_k = k - 1

        and mmm = Array.make_matrix n n (Float_cons 0.) in

         for i = 0 to nn do

          let row_output = mmm.(i) in

           for j = 0 to nn do

            let mm = Array.make_matrix k k 0. in

             for ii = 0 to k_k do

              let ligne_sortie = mm.(ii)

              and ligne_entree = m.( k * i + ii ) in

               for jj = 0 to k_k do

                ligne_sortie.(jj) <- ligne_entree.( k * j + jj )

               done ;

             done ;

             row_output.(j) <- Float_matrix_cons mm

           done ;

         done ;

         [| Foa_matrix_cons mmm ; ( Foa_vector_cons [| Float_vector_cons [| float rr ; float cc |] |] ) |] ;;






(** 
matrix_foa_cut parts matrix
 *)


let matrix_foa_cut = fun n (m:float_or_array) ->

 if n <= 1 then m else

  let r = foa_numrows m

  and c = foa_numcolumns m in

   let pp = min r c in

    if pp < n then  failwith "Too short in Matrix.matrix_foa_cut."

    else

     let k = pp / n in

      let mm = Array.make_matrix n n (Float_cons 0.) in

       match m with

        | Float_matrix_cons w ->

         for i = 0 to n-2 do 

          let row_output = mm.(i)

          and debut = k*i

          and fin = k*(i + 1) - 1 in

           begin

            for j = 0 to n-2 do

             row_output.(j) <- Float_matrix_cons ( float_sub_matrix w debut fin (k*j) (k*(j + 1) - 1) )

            done ;

            row_output.(n - 1) <- Float_matrix_cons ( float_sub_matrix w debut fin (k*(n - 1)) (c - 1) ) ;

           end 

         done ;

         let row_output = mm.(n - 1)

         and debut = k * ( n - 1 )

         and fin = r - 1 in

          begin

           for j = 0 to n-2 do

            row_output.(j) <- Float_matrix_cons ( float_sub_matrix w debut fin (k*j) (k*(j + 1) - 1) )

           done ;

           row_output.(n - 1) <- Float_matrix_cons ( float_sub_matrix w debut fin debut (c - 1) ) ;

          end ;

          Foa_matrix_cons mm 

        | Foa_matrix_cons ww ->

         for i = 0 to n-2 do 

          let row_output = mm.(i)

          and debut = k*i

          and fin = k*(i + 1) - 1 in

           begin

            for j = 0 to n-2 do

             row_output.(j) <- Foa_matrix_cons ( sub_matrix ww debut fin (k*j) (k*(j + 1) - 1) )

            done ;

           row_output.(n - 1) <- Foa_matrix_cons ( sub_matrix ww debut fin (k*(n - 1)) (c - 1) ) ;

           end 

         done ;

         let row_output = mm.(n - 1)

         and debut = k * ( n - 1 )

         and fin = r - 1 in

          begin

           for j = 0 to n-2 do

            row_output.(j) <- Foa_matrix_cons ( sub_matrix ww debut fin (k*j) (k*(j + 1) - 1) )

           done ;

           row_output.(n - 1) <- Foa_matrix_cons ( sub_matrix ww debut fin debut (c - 1) ) ;

          end ;

          Foa_matrix_cons mm

        | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_cut." ;;






(** 
matrix_foa_paste matrix
 *)


let matrix_foa_paste = function (m:float_or_array) ->

 match (foa_thickness m) with

  | 0 -> m

  | 1 ->

   let mm = matrix_foa_demakeup m in

    let r = Array.length mm

    and cc = (numcolumns mm) - 1

    and m_m = ref [] in

     for i = 0 to r - 1 do

      let w = mm.(i) in

       let ww = matrix_float_demakeup w.(0) in

        let rr = Array.length ww in

         for k = 0 to rr - 1 do

          let row_output = ref ww.(k) in

           for j = 1 to cc do 

            row_output := Array.append !row_output ( ( matrix_float_demakeup w.(j) ).(k) )

           done ;

         ww.(k) <- !row_output

       done ;

      m_m := ww::!m_m

    done ;

    m_m := List.rev !m_m ;

    Float_matrix_cons (Array.concat !m_m)

  | _ ->

   let r = foa_numrows m

   and cc = (foa_numcolumns m) - 1

   and m_m = ref [] in

    for i = 0 to r - 1 do

     let mm = (matrix_foa_demakeup m).(i) in

      let mmm = matrix_foa_demakeup mm.(0)

      and rr = foa_numrows mm.(0) in

       for k = 0 to rr - 1 do

        let row_output = ref mmm.(k) in

         for j = 1 to cc do 

          row_output := Array.append !row_output ( ( matrix_foa_demakeup mm.(j) ).(k) )

         done ;

         mmm.(k) <- !row_output

       done ;

       m_m := mmm::!m_m

     done ;

     m_m := List.rev !m_m ;

     Foa_matrix_cons (Array.concat !m_m) ;;






(** 
matrix_float_crash data
 *)


let matrix_float_crash = fun (data:float_or_array array) ->

 let m = data.(0) and s = vector_foa_demakeup data.(1) in

  let margin = vector_float_demakeup s.(0)

  and mm = matrix_float_demakeup (matrix_foa_paste m) in

    let endrow = (Array.length mm) - (int_of_float margin.(0)) - 1

    and endcolumn = (numcolumns mm) - (int_of_float margin.(1)) - 1 in

     float_sub_matrix mm 0 endrow 0 endcolumn ;;






(** 
matrix_int_cut parts matrix
 *)


let matrix_int_cut = fun (n:int) (w:int array array) ->

 if n <= 1 then [| Int_matrix_cons w ; Ioa_vector_cons ( [| Int_vector_cons [| 0 ; 0 |] |] ) |] else

  let r = Array.length w

  and c = numcolumns w in

   let pg = Util.int_max r c in

    let k = int_of_float ( ceil ( (float pg) /. (float n) ) ) in

     let kk = k * n in

      let rr = kk - r

      and cc = kk - c

      and nn = n - 1 in

       let m = Array.make_matrix kk kk 0 in

        for i = 0 to r - 1 do

         let row_output = m.(i)

         and row_input = w.(i) in

          Array.blit row_input 0 row_output 0 c

        done ;

        if (rr > 0) or (cc > 0) then 

         begin

          for i = ( min r c) to kk - 1 do

           m.(i).(i) <- 1

          done

         end ;

        let k_k = k - 1

        and mmm = Array.make_matrix n n (Int_cons 0) in

         for i = 0 to nn do

          let row_output = mmm.(i) in

           for j = 0 to nn do

            let mm = Array.make_matrix k k 0 in

             for ii = 0 to k_k do

              let ligne_sortie = mm.(ii)

              and ligne_entree = m.( k * i + ii ) in

               for jj = 0 to k_k do

                ligne_sortie.(jj) <- ligne_entree.( k * j + jj )

               done ;

             done ;

             row_output.(j) <- Int_matrix_cons mm

           done ;

         done ;

         [| Ioa_matrix_cons mmm ; ( Ioa_vector_cons [| Int_vector_cons [| rr ; cc |] |] ) |] ;;






(** 
matrix_ioa_cut parts matrix
 *)


let matrix_ioa_cut = fun n (m:int_or_array) ->

 if n <= 1 then m else

  let r = ioa_numrows m

  and c = ioa_numcolumns m in

   let pp = min r c

   and rr = pred r in

    if pp < n then  failwith "Too short in Matrix.matrix_ioa_cut."

    else

     let k = pp / n in

      let mm = Array.make_matrix n n (Int_cons 0) in

       match m with

        | Int_matrix_cons w ->

         for i = 0 to n-2 do 

          let row_output = mm.(i)

          and debut = k*i

          and fin = k*(i + 1) - 1 in

           begin

            for j = 0 to n-2 do

             row_output.(j) <- Int_matrix_cons ( int_sub_matrix w debut fin (k*j) (k*(j + 1) - 1) )

            done ;

            row_output.(n - 1) <- Int_matrix_cons ( int_sub_matrix w debut fin (k*(n - 1)) (c - 1) ) ;

           end 

         done ;

         let row_output = mm.(n - 1)

         and debut = k * ( n - 1 )

         and fin = rr in

          begin

           for j = 0 to n-2 do

            row_output.(j) <- Int_matrix_cons ( int_sub_matrix w debut fin (k*j) (k*(j + 1) - 1) )

           done ;

           row_output.(n - 1) <- Int_matrix_cons ( int_sub_matrix w debut fin debut (c - 1) ) ;

          end ;

          Ioa_matrix_cons mm 

        | Ioa_matrix_cons ww ->

         for i = 0 to n-2 do 

          let row_output = mm.(i)

          and debut = k*i

          and fin = k*(i + 1) - 1 in

           begin

            for j = 0 to n-2 do

             row_output.(j) <- Ioa_matrix_cons ( sub_matrix ww debut fin (k*j) (k*(j + 1) - 1) )

            done ;

           row_output.(n - 1) <- Ioa_matrix_cons ( sub_matrix ww debut fin (k*(n - 1)) (c - 1) ) ;

           end 

         done ;

         let row_output = mm.(n - 1)

         and debut = k * ( n - 1 )

         and fin = rr in

          begin

           for j = 0 to n-2 do

            row_output.(j) <- Ioa_matrix_cons ( sub_matrix ww debut fin (k*j) (k*(j + 1) - 1) )

           done ;

           row_output.(n - 1) <- Ioa_matrix_cons ( sub_matrix ww debut fin debut (c - 1) ) ;

          end ;

          Ioa_matrix_cons mm

        | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_cut." ;;






(** 
matrix_ioa_paste matrix
 *)


let matrix_ioa_paste = function (m:int_or_array) ->

 match (ioa_thickness m) with

  | 0 -> m

  | 1 ->

   let r = ioa_numrows m

   and cc = (ioa_numcolumns m) - 1

   and m_m = ref [] in

    for i = 0 to r - 1 do

     let mm = (matrix_ioa_demakeup m).(i) in

      let mmm = matrix_int_demakeup mm.(0)

      and rr = ioa_numrows mm.(0) in

       for k = 0 to rr -1 do

        let row_output = ref mmm.(k) in

         for j = 1 to cc do 

          row_output := Array.append !row_output ( (matrix_int_demakeup mm.(j)).(k) )

         done ;

         mmm.(k) <- !row_output

        done ;

       m_m := mmm::!m_m

     done ;

     m_m := List.rev !m_m ;

     Int_matrix_cons (Array.concat !m_m)

  | _ ->

   let r = ioa_numrows m

   and cc = (ioa_numcolumns m) - 1 

   and m_m = ref [] in

    for i = 0 to r - 1 do

     let mm = (matrix_ioa_demakeup m).(i) in

      let mmm = matrix_ioa_demakeup mm.(0)

      and rr = ioa_numrows mm.(0) in

       for k = 0 to rr - 1 do

        let row_output = ref mmm.(k) in

         for j = 1 to cc do 

          row_output := Array.append !row_output ( (matrix_ioa_demakeup mm.(j)).(k) )

         done ;

         mmm.(k) <- !row_output

        done ;

       m_m := mmm::!m_m

     done ;

     m_m := List.rev !m_m ;

     Ioa_matrix_cons (Array.concat !m_m) ;;






(** 
matrix_foa_hash base matrix
 *)


let rec matrix_foa_hash = fun b (m:float_or_array) ->

 let r = foa_numrows m

 and c = foa_numcolumns m in

  let pp = min r c in

   if b >= pp then m

   else let mm = matrix_foa_cut (pp/b) m in

    matrix_foa_hash b mm ;;




(** 
matrix_ioa_hash base matrix
 *)


let rec matrix_ioa_hash = fun b (m:int_or_array) ->

 let r = ioa_numrows m

 and c = ioa_numcolumns m in

  let pp = min r c in

   if b >= pp then m

   else let mm = matrix_ioa_cut (pp/b) m in

    matrix_ioa_hash b mm ;;




(** 
matrix_foa_crash matrix
 *)


let rec matrix_foa_crash = function (m:float_or_array) ->

 match foa_thickness m with

 | 0 -> m

 | 1 -> matrix_foa_paste m 

 | _ -> matrix_foa_crash (matrix_foa_paste m) ;;




(** 
matrix_ioa_crash matrix
 *)


let rec matrix_ioa_crash = function (m:int_or_array) ->

 match ioa_thickness m with

 | 0 -> m

 | 1 -> matrix_ioa_paste m 

 | _ -> matrix_ioa_crash (matrix_ioa_paste m) ;;










(** 
§ 
 *)



(**

++++++ Operations on float vectors.



Opérations sur les vecteurs réels. ++++++ 

*)



(** 
 
 *)











(** 
vector_foa_scal_mult coefficient vector
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_scal_mult = fun (lambda:float) (v:float_or_array) ->

 match v with

 | Float_cons x -> Float_cons ( x *. lambda )

 | Float_vector_cons u -> Float_vector_cons ( vector_float_scal_mult lambda u )

 | Foa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_foa_scal_mult lambda w.(i) 

     done ;

     Foa_vector_cons !vvv 

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_scal_mult." ;;






(** 
vector_foa_scal_add coefficient vector
 Inner blocks reduced to a real are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec vector_foa_scal_add = fun (lambda:float) (v:float_or_array) ->

 match v with

 | Float_cons x -> Float_cons ( lambda +. x )

 | Float_vector_cons u -> Float_vector_cons ( vector_float_scal_add lambda u )

 | Foa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_foa_scal_add lambda w.(i) 

     done ;

     Foa_vector_cons !vvv 

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_scal_add." ;;






(** 
vector_foa_scal_right_div coefficient vector
 Inner blocks reduced to a real are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec vector_foa_scal_right_div = fun (lambda:float) (v:float_or_array) ->

 match v with

 | Float_cons x -> Float_cons ( x /. lambda )

 | Float_vector_cons u -> Float_vector_cons ( vector_float_scal_right_div lambda u )

 | Foa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_foa_scal_right_div lambda w.(i) 

     done ;

     Foa_vector_cons !vvv 

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_scal_right_div." ;;






(** 
vector_foa_scal_left_div coefficient vector
 Inner blocks reduced to areal are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec vector_foa_scal_left_div = fun (lambda:float) (v:float_or_array) ->

 match v with

 | Float_cons x ->  Float_cons ( lambda /. x ) 

 | Float_vector_cons u -> Float_vector_cons ( vector_float_scal_left_div lambda u )

 | Foa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_foa_scal_left_div lambda w.(i) 

     done ;

     Foa_vector_cons !vvv 

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_scal_left_div." ;;






(** 
vector_foa_scal_right_sub coefficient vector
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_scal_right_sub = fun (lambda:float) (v:float_or_array) ->

 match v with

 | Float_cons 0. -> Float_cons ( -. lambda )

 | Float_vector_cons u -> Float_vector_cons ( vector_float_scal_right_sub lambda u )

 | Foa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_foa_scal_right_sub lambda w.(i) 

     done ;

     Foa_vector_cons !vvv 

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_scal_right_sub." ;;






(** 
vector_foa_scal_left_sub coefficient vector
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_scal_left_sub = fun (lambda:float) (v:float_or_array) ->

 match v with

 | Float_cons 0. -> Float_cons lambda

 | Float_vector_cons u -> Float_vector_cons ( vector_float_scal_left_sub lambda u )

 | Foa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_foa_scal_left_sub lambda w.(i) 

     done ;

     Foa_vector_cons !vvv 

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_scal_left_sub." ;;






(** 
vector_foa_opp vector
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_opp = function (v:float_or_array) -> match v with

 | Float_cons 0. -> v

 | Float_vector_cons u -> Float_vector_cons ( vector_float_opp u )

 | Foa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_foa_opp w.(i) 

     done ;

     Foa_vector_cons !vvv 

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_opp." ;;






(** 
vector_foa_coeff_prod vector1 vector2
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_coeff_prod = fun (v:float_or_array) (vv:float_or_array) ->

 match v with

 | Float_cons 0. -> v

 | Float_cons x -> vector_foa_scal_mult x vv

 | Float_vector_cons u ->

  begin

   match vv with 

    | Float_cons 0. -> vv

    | Float_cons y ->  vector_foa_scal_mult y v

    | Float_vector_cons uu -> Float_vector_cons ( vector_float_coeff_prod u uu )

    | _ -> failwith "Not a float_or_array vector of thickness 0 in Matrix.vector_foa_coeff_prod."

  end

 | Foa_vector_cons w ->

  begin

   match vv with

    | Float_cons 0. -> vv

    | Float_cons y -> vector_foa_scal_mult y v

    | Foa_vector_cons ww ->

     begin

      let r = Array.length w in

       let vvv = ref (Array.make r w.(0)) in

        for i = 0 to r - 1 do

         !vvv.(i) <- vector_foa_coeff_prod w.(i) ww.(i)

        done ;

        Foa_vector_cons !vvv 

     end

   | _ -> failwith "Not a float_or_array vector of same thickness in Matrix.vector_foa_coeff_prod."

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_coeff_prod." ;;






(** 
vector_foa_sum vector
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_sum = function (v:float_or_array) ->

 match v with

 | Float_cons 0. -> 0.

 | Float_vector_cons u -> vector_float_sum u

 | Foa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref 0. in

     for i = 0 to r - 1 do

      vvv := !vvv +. vector_foa_sum w.(i) 

     done ;

     !vvv

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_sum." ;;






(** 
vector_foa_scal_prod vector1 vector2
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_scal_prod = fun (v:float_or_array) (vv:float_or_array) ->

 match v with

 | Float_cons 0. -> 0.

 | Float_cons x -> x *. vector_foa_sum vv

 | Float_vector_cons u ->

  begin

   match vv with 

    | Float_cons 0. -> 0.

    | Float_cons y -> y *. vector_float_sum u

    | Float_vector_cons uu -> vector_float_scal_prod u uu

    | _ -> failwith "Not a float_or_array vector of thickness 0 in Matrix.vector_foa_scal_prod."

  end

 | Foa_vector_cons w ->

  begin

   match vv with

    | Float_cons 0. -> 0.

    | Float_cons y -> y *. vector_foa_sum v

    | Foa_vector_cons ww ->

     begin

      let r = Array.length w in

       let vvv = ref 0. in

        for i = 0 to r - 1 do

         vvv := !vvv +. vector_foa_scal_prod w.(i) ww.(i)

        done ;

        !vvv 

     end

   | _ -> failwith "Not a float_or_array vector of same thickness in Matrix.vector_foa_scal_prod."

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_scal_prod." ;;






(** 
vector_foa_max vector
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_max = function (v:float_or_array) ->

 match v with

 | Float_cons x -> x

 | Float_vector_cons u -> vector_float_max u

 | Foa_vector_cons w ->

  begin

   let vvv = ref ( -. max_float )

   and rr = (Array.length w) - 1 in

    for i = 0 to rr do

     vvv := max !vvv ( vector_foa_max w.(i) )

    done ;

    !vvv

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_max." ;;






(** 
vector_foa_min vector
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_min = function (v:float_or_array) ->

 match v with

 | Float_cons x -> x

 | Float_vector_cons u -> vector_float_min u

 | Foa_vector_cons w ->

  begin

   let vvv = ref max_float

   and rr = (Array.length w) - 1 in

    for i = 0 to rr do

     vvv := min !vvv ( vector_foa_min w.(i) )

    done ;

    !vvv

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_min." ;;






(** 
vector_foa_plus vector1 vector2
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_plus = fun (v:float_or_array) (vv:float_or_array) ->

 match v with

 | Float_cons 0. -> vv

 | Float_cons x -> vector_foa_scal_add x vv

 | Float_vector_cons u ->

  begin

   match vv with 

    | Float_cons 0. -> v

    | Float_cons y ->  vector_foa_scal_add y v

    | Float_vector_cons uu -> Float_vector_cons ( vector_float_plus u uu )

    | _ -> failwith "Not a float_or_array vector of thickness 0 in Matrix.vector_foa_plus."

  end

 | Foa_vector_cons w ->

  begin

   match vv with

    | Float_cons 0. -> v

    | Float_cons y -> vector_foa_scal_add y v

    | Foa_vector_cons ww ->

     begin

      let r = Array.length w in

       let vvv = ref (Array.make r w.(0)) in

        for i = 0 to r - 1 do

         !vvv.(i) <- vector_foa_plus w.(i) ww.(i)

        done ;

        Foa_vector_cons !vvv 

     end

   | _ -> failwith "Not a float_or_array vector of same thickness in Matrix.vector_foa_plus."

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_plus." ;;






(** 
vector_foa_minus vector1 vector2
 Inner blocks reduced to the real 0. are accepted.



Des blocs réduits au réel 0. sont tolérés. *)


let rec vector_foa_minus = fun (v:float_or_array) (vv:float_or_array) ->

 match v with

 | Float_cons 0. -> vector_foa_opp vv

 | Float_cons x -> vector_foa_scal_right_sub x vv

 | Float_vector_cons u ->

  begin

   match vv with 

    | Float_cons 0. -> v

    | Float_cons y ->  vector_foa_scal_left_sub y v

    | Float_vector_cons uu -> Float_vector_cons ( vector_float_minus u uu )

    | _ -> failwith "Not a float_or_array vector of thickness 0 in Matrix.vector_foa_minus."

  end

 | Foa_vector_cons w ->

  begin

   match vv with

    | Float_cons 0. -> v

    | Float_cons y -> vector_foa_scal_left_sub y v

    | Foa_vector_cons ww ->

     begin

      let r = Array.length w in

       let vvv = ref (Array.make r w.(0)) in

        for i = 0 to r - 1 do

         !vvv.(i) <- vector_foa_minus w.(i) ww.(i)

        done ;

        Foa_vector_cons !vvv 

     end

   | _ -> failwith "Not a float_or_array vector of same thickness in Matrix.vector_foa_minus."

  end

 | _ -> failwith "Not a float_or_array vector in Matrix.vector_foa_minus." ;;










(** 
§ 
 *)



(**

++++++ Operations on integer vectors.



Opérations sur les vecteurs entiers. ++++++ 

*)



(** 
 
 *)











(** 
vector_ioa_scal_mult coefficient vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_scal_mult = fun (lambda:int) (v:int_or_array) ->

 match v with

 | Int_cons 0 -> v

 | Int_vector_cons u -> Int_vector_cons ( vector_int_scal_mult lambda u )

 | Ioa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_ioa_scal_mult lambda w.(i) 

     done ;

     Ioa_vector_cons !vvv 

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_scal_mult." ;;






(** 
vector_ioa_scal_add coefficient vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_scal_add = fun (lambda:int) (v:int_or_array) ->

 match v with

 | Int_cons 0 -> Int_cons lambda

 | Int_vector_cons u -> Int_vector_cons ( vector_int_scal_add lambda u )

 | Ioa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_ioa_scal_add lambda w.(i) 

     done ;

     Ioa_vector_cons !vvv 

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_scal_add." ;;






(** 
vector_ioa_scal_right_div coefficient vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_scal_right_div = fun (lambda:int) (v:int_or_array) ->

 match v with

 | Int_cons 0 -> v

 | Int_vector_cons u -> Int_vector_cons ( vector_int_scal_right_div lambda u )

 | Ioa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_ioa_scal_right_div lambda w.(i) 

     done ;

     Ioa_vector_cons !vvv 

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_scal_right_div." ;;






(** 
vector_ioa_scal_left_div coefficient vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_scal_left_div = fun (lambda:int) (v:int_or_array) ->

 match v with

 | Int_cons 0 -> failwith "Division_by_zero in Matrix.vector_ioa_scal_left_div."

 | Int_vector_cons u -> Int_vector_cons ( vector_int_scal_left_div lambda u )

 | Ioa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_ioa_scal_left_div lambda w.(i) 

     done ;

     Ioa_vector_cons !vvv 

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_scal_left_div." ;;






(** 
vector_ioa_scal_right_mod coefficient vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_scal_right_mod = fun (lambda:int) (v:int_or_array) ->

 match v with

 | Int_cons 0 -> v

 | Int_vector_cons u -> Int_vector_cons ( vector_int_scal_right_mod lambda u )

 | Ioa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_ioa_scal_right_mod lambda w.(i) 

     done ;

     Ioa_vector_cons !vvv 

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_scal_right_mod." ;;






(** 
vector_ioa_scal_left_mod coefficient vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_scal_left_mod = fun (lambda:int) (v:int_or_array) ->

 match v with

 | Int_cons 0 -> Int_cons lambda

 | Int_vector_cons u -> Int_vector_cons ( vector_int_scal_left_mod lambda u )

 | Ioa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_ioa_scal_left_mod lambda w.(i) 

     done ;

     Ioa_vector_cons !vvv 

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_scal_left_mod." ;;






(** 
vector_ioa_scal_right_sub coefficient vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_scal_right_sub = fun (lambda:int) (v:int_or_array) ->

 match v with

 | Int_cons 0 -> Int_cons ( - lambda )

 | Int_vector_cons u -> Int_vector_cons ( vector_int_scal_right_sub lambda u )

 | Ioa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_ioa_scal_right_sub lambda w.(i) 

     done ;

     Ioa_vector_cons !vvv 

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_scal_right_sub." ;;






(** 
vector_ioa_scal_left_sub coefficient vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_scal_left_sub = fun (lambda:int) (v:int_or_array) ->

 match v with

 | Int_cons 0 -> Int_cons lambda

 | Int_vector_cons u -> Int_vector_cons ( vector_int_scal_left_sub lambda u )

 | Ioa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_ioa_scal_left_sub lambda w.(i) 

     done ;

     Ioa_vector_cons !vvv 

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_scal_left_sub." ;;






(** 
vector_ioa_opp vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_opp = function (v:int_or_array) ->

 match v with

 | Int_cons 0 -> v

 | Int_vector_cons u -> Int_vector_cons ( vector_int_opp u )

 | Ioa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref (Array.make r w.(0)) in

     for i = 0 to r - 1 do

      !vvv.(i) <- vector_ioa_opp w.(i) 

     done ;

     Ioa_vector_cons !vvv 

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_opp." ;;






(** 
vector_ioa_coeff_prod vector1 vector2
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_coeff_prod = fun (v:int_or_array) (vv:int_or_array) ->

 match v with

 | Int_cons 0 -> v

 | Int_cons x -> vector_ioa_scal_mult x vv

 | Int_vector_cons u ->

  begin

   match vv with 

    | Int_cons 0 -> vv

    | Int_cons y ->  vector_ioa_scal_mult y v

    | Int_vector_cons uu -> Int_vector_cons ( vector_int_coeff_prod u uu )

    | _ -> failwith "Not an int_or_array vector of thickness 0 in Matrix.vector_ioa_coeff_prod."

  end

 | Ioa_vector_cons w ->

  begin

   match vv with

    | Int_cons 0 -> vv

    | Int_cons y -> vector_ioa_scal_mult y v

    | Ioa_vector_cons ww ->

     begin

      let r = Array.length w in

       let vvv = ref (Array.make r w.(0)) in

        for i = 0 to r - 1 do

         !vvv.(i) <- vector_ioa_coeff_prod w.(i) ww.(i)

        done ;

        Ioa_vector_cons !vvv 

     end

   | _ -> failwith "Not an int_or_array vector of same thickness in Matrix.vector_ioa_coeff_prod."

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_coeff_prod." ;;






(** 
vector_ioa_coeff_div vector1 vector2
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_coeff_div = fun (v:int_or_array) (vv:int_or_array) ->

 match v with

 | Int_cons 0 -> v

 | Int_cons x -> vector_ioa_scal_mult x vv

 | Int_vector_cons u ->

  begin

   match vv with 

    | Int_cons 0 -> vv

    | Int_cons y ->  vector_ioa_scal_mult y v

    | Int_vector_cons uu -> Int_vector_cons ( vector_int_coeff_div u uu )

    | _ -> failwith "Not an int_or_array vector of thickness 0 in Matrix.vector_ioa_coeff_div."

  end

 | Ioa_vector_cons w ->

  begin

   match vv with

    | Int_cons 0 -> vv

    | Int_cons y -> vector_ioa_scal_mult y v

    | Ioa_vector_cons ww ->

     begin

      let r = Array.length w in

       let vvv = ref (Array.make r w.(0)) in

        for i = 0 to r - 1 do

         !vvv.(i) <- vector_ioa_coeff_div w.(i) ww.(i)

        done ;

        Ioa_vector_cons !vvv 

     end

   | _ -> failwith "Not an int_or_array vector of same thickness in Matrix.vector_ioa_coeff_div."

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_coeff_div." ;;






(** 
vector_ioa_coeff_mod vector1 vector2
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_coeff_mod = fun (v:int_or_array) (vv:int_or_array) ->

 match v with

 | Int_cons 0 -> v

 | Int_cons x -> vector_ioa_scal_mult x vv

 | Int_vector_cons u ->

  begin

   match vv with 

    | Int_cons 0 -> vv

    | Int_cons y ->  vector_ioa_scal_mult y v

    | Int_vector_cons uu -> Int_vector_cons ( vector_int_coeff_mod u uu )

    | _ -> failwith "Not an int_or_array vector of thickness 0 in Matrix.vector_ioa_coeff_mod."

  end

 | Ioa_vector_cons w ->

  begin

   match vv with

    | Int_cons 0 -> vv

    | Int_cons y -> vector_ioa_scal_mult y v

    | Ioa_vector_cons ww ->

     begin

      let r = Array.length w in

       let vvv = ref (Array.make r w.(0)) in

        for i = 0 to r - 1 do

         !vvv.(i) <- vector_ioa_coeff_mod w.(i) ww.(i)

        done ;

        Ioa_vector_cons !vvv 

     end

   | _ -> failwith "Not an int_or_array vector of same thickness in Matrix.vector_ioa_coeff_mod."

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_coeff_mod." ;;






(** 
vector_ioa_sum vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_sum = function (v:int_or_array) ->

 match v with

 | Int_cons 0 -> 0

 | Int_vector_cons u -> vector_int_sum u

 | Ioa_vector_cons w ->

  begin

   let r = Array.length w in

    let vvv = ref 0 in

     for i = 0 to r - 1 do

      vvv := !vvv + vector_ioa_sum w.(i) 

     done ;

     !vvv

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_sum." ;;






(** 
vector_ioa_scal_prod vector1 vector2
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_scal_prod = fun (v:int_or_array) (vv:int_or_array) ->

 match v with

 | Int_cons 0 -> 0

 | Int_cons x -> x * vector_ioa_sum vv

 | Int_vector_cons u ->

  begin

   match vv with 

    | Int_cons 0 -> 0

    | Int_cons y -> y * vector_int_sum u

    | Int_vector_cons uu -> vector_int_scal_prod u uu

    | _ -> failwith "Not an int_or_array vector of thickness 0 in Matrix.vector_ioa_scal_prod."

  end

 | Ioa_vector_cons w ->

  begin

   match vv with

    | Int_cons 0 -> 0

    | Int_cons y -> y * vector_ioa_sum v

    | Ioa_vector_cons ww ->

     begin

      let r = Array.length w in

       let vvv = ref 0 in

        for i = 0 to r - 1 do

         vvv := !vvv + vector_ioa_scal_prod w.(i) ww.(i)

        done ;

        !vvv 

     end

   | _ -> failwith "Not an int_or_array vector of same thickness in Matrix.vector_ioa_scal_prod."

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_scal_prod." ;;






(** 
vector_ioa_max vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_max = function (v:int_or_array) ->

 match v with

 | Int_cons x -> x

 | Int_vector_cons u -> vector_int_max u

 | Ioa_vector_cons w ->

  begin

   let vvv = ref ( - max_int )

   and rr = (Array.length w) - 1 in

    for i = 0 to rr do

     vvv := Util.int_max !vvv ( vector_ioa_max w.(i) )

    done ;

    !vvv

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_max." ;;






(** 
vector_ioa_min vector
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_min = function (v:int_or_array) ->

 match v with

 | Int_cons x -> x

 | Int_vector_cons u -> vector_int_min u

 | Ioa_vector_cons w ->

  begin

   let vvv = ref max_int

   and rr = (Array.length w) - 1 in

    for i = 0 to rr do

     vvv := min !vvv ( vector_ioa_min w.(i) )

    done ;

    !vvv

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_min." ;;






(** 
vector_ioa_plus vector1 vector2
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_plus = fun (v:int_or_array) (vv:int_or_array) ->

 match v with

 | Int_cons 0 -> vv

 | Int_cons x -> vector_ioa_scal_add x vv

 | Int_vector_cons u ->

  begin

   match vv with 

    | Int_cons 0 -> v

    | Int_cons y ->  vector_ioa_scal_add y v

    | Int_vector_cons uu -> Int_vector_cons ( vector_int_plus u uu )

    | _ -> failwith "Not an int_or_array vector of thickness 0 in Matrix.vector_ioa_plus."

  end

 | Ioa_vector_cons w ->

  begin

   match vv with

    | Int_cons 0 -> v

    | Int_cons y -> vector_ioa_scal_add y v

    | Ioa_vector_cons ww ->

     begin

      let r = Array.length w in

       let vvv = ref (Array.make r w.(0)) in

        for i = 0 to r - 1 do

         !vvv.(i) <- vector_ioa_plus w.(i) ww.(i)

        done ;

        Ioa_vector_cons !vvv 

     end

   | _ -> failwith "Not an int_or_array vector of same thickness in Matrix.vector_ioa_plus."

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_plus." ;;






(** 
vector_ioa_minus vector1 vector2
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec vector_ioa_minus = fun (v:int_or_array) (vv:int_or_array) ->

 match v with

 | Int_cons 0 -> vector_ioa_opp vv

 | Int_cons x -> vector_ioa_scal_right_sub x vv

 | Int_vector_cons u ->

  begin

   match vv with 

    | Int_cons 0 -> v

    | Int_cons y ->  vector_ioa_scal_left_sub y v

    | Int_vector_cons uu -> Int_vector_cons ( vector_int_minus u uu )

    | _ -> failwith "Not an int_or_array vector of thickness 0 in Matrix.vector_ioa_minus."

  end

 | Ioa_vector_cons w ->

  begin

   match vv with

    | Int_cons 0 -> v

    | Int_cons y -> vector_ioa_scal_left_sub y v

    | Ioa_vector_cons ww ->

     begin

      let r = Array.length w in

       let vvv = ref (Array.make r w.(0)) in

        for i = 0 to r - 1 do

         !vvv.(i) <- vector_ioa_minus w.(i) ww.(i)

        done ;

        Ioa_vector_cons !vvv 

     end

   | _ -> failwith "Not an int_or_array vector of same thickness in Matrix.vector_ioa_minus."

  end

 | _ -> failwith "Not an int_or_array vector in Matrix.vector_ioa_minus." ;;










(** 
§ 
 *)



(**

++++++ Search, extraction, affectation, measure and display.



Recherche, extraction, affectation, mesure et affichage. ++++++ 

*)



(** 
 
 *)











(** 
matrix_foa_max matrix
 Inner blocks reduced to a real are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_max = function (m:float_or_array) ->

 match m with

 | Float_cons x -> x

 | Float_matrix_cons u -> matrix_float_max u

 | Foa_matrix_cons w ->

  begin

   let accu = ref (-. max_float) in

    for i = 0 to (Array.length w) - 1 do

     let row = w.(i) in

      for j = 0 to (Array.length row) - 1 do

       accu := max !accu ( matrix_foa_max row.(j) )

      done

    done ;

    !accu

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_max." ;;






(** 
matrix_foa_min matrix
 Inner blocks reduced to a real are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_min = function (m:float_or_array) ->

 match m with

 | Float_cons x -> x

 | Float_matrix_cons u -> matrix_float_min u

 | Foa_matrix_cons w ->

  begin

   let accu = ref (max_float) in

    for i = 0 to (Array.length w) - 1 do

     let row = w.(i) in

      for j = 0 to (Array.length row) - 1 do

       accu := min !accu ( matrix_foa_min row.(j) )

      done

    done ;

    !accu

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_min." ;;






(** 
vector_foa_find_last element vector
 vector_foa_find_last returns [-1] if it does not find:



vector_foa_find_last retourne [-1] s'il ne trouve pas. *)


let rec vector_foa_find_last = fun (x:float) (v:float_or_array) ->

 match (foa_thickness v) with

 | 0 -> [ vector_float_find_last x (vector_float_demakeup v) ]

 | _ ->

  let w = vector_foa_demakeup v in

   let r = Array.length w

   and index = ref (-1) 

   and suite = ref [] in

    let i = ref ( r - 1 ) in

     while !i >= 0 do

      let essaisuite = vector_foa_find_last x w.(!i) in

       if (List.hd essaisuite <> -1) then 

        begin

         index:= !i ;

         suite := essaisuite ;

         i := -1 ;

        end

       else i := !i - 1 

     done ;

     !index::!suite ;;






(** 
vector_foa_find_first element vector
 vector_foa_find_first returns [-1] if it does not find:



vector_foa_find_first retourne [-1] s'il ne trouve pas. *)


let rec vector_foa_find_first = fun (x:float) (v:float_or_array) ->

 match (foa_thickness v) with

 | 0 -> [ vector_float_find_first x (vector_float_demakeup v) ]

 | _ ->

 let w = vector_foa_demakeup v in

  let r = Array.length w

  and index = ref (-1) 

  and suite = ref [] 

  and i = ref 0 in

   while  !i < r do

    let essaisuite = vector_foa_find_first x w.(!i) in

     if (List.hd essaisuite <> -1) then 

      begin

       index := !i ;

       suite := essaisuite ;

       i := r ;

      end

     else i := !i + 1 ;

   done ;

  !index::!suite ;;






(** 
vector_foa_extract_element position vector
 vector_foa_extract_element walks 
along the layers following the list of indexes up to the desired depth.



vector_foa_extract_element parcourt les couches en suivant la liste des indices jusqu'à la profondeur souhaitée. *)


let rec vector_foa_extract_element = fun (pos:int list) (v:float_or_array) ->

 match ( List.length pos ) with

 | 0 -> failwith "List too short in Matrix.vector_foa_extract_element." 

 | 1 ->

  begin

   match (foa_thickness v) with

   | 0 -> Float_cons (vector_float_demakeup v).(List.hd pos)

   | _ -> (vector_foa_demakeup v).(List.hd pos) 

  end

 | _ -> vector_foa_extract_element (List.tl pos) (vector_foa_demakeup v).(List.hd pos) ;;






(** 
matrix_foa_extract_element position matrix
 matrix_foa_extract_element walks 
along the layers following the list of indexes up to the desired depth.



matrix_foa_extract_element parcourt les couches en suivant la liste des indices jusqu'à la profondeur souhaitée. *)


let rec matrix_foa_extract_element = fun (pos:int array list) (m:float_or_array) ->

 match ( List.length pos ) with

 | 0 -> failwith "List too short in Matrix.matrix_foa_extract_element." 

 | 1 ->

  let index = List.hd pos in

   begin

    match (foa_thickness m) with

    | 0 -> Float_cons (matrix_float_demakeup m).(index.(0)).(index.(1))

    | _ -> (matrix_foa_demakeup m).(index.(0)).(index.(1))

   end

 | _ ->

  let index = List.hd pos in

   matrix_foa_extract_element (List.tl pos) (matrix_foa_demakeup m).(index.(0)).(index.(1)) ;;






(** 
matrix_foa_extract_column column matrix
 matrix_foa_extract_column works on the superficial layer.



matrix_foa_extract_column travaille sur la couche superficielle. *)


let matrix_foa_extract_column = fun (i:int) (m:float_or_array) ->

 match (foa_thickness m) with

  | 0 ->

   let col = extract_column i (matrix_float_demakeup m) in

    Float_vector_cons col

  | _ ->

   let col = extract_column i (matrix_foa_demakeup m) in

    Foa_vector_cons col ;;






(** 
matrix_foa_extract_row row matrix
 matrix_foa_extract_row works on the superficial layer.



matrix_foa_extract_row travaille sur la couche superficielle. *)


let matrix_foa_extract_row = fun (i:int) (m:float_or_array) ->

 match (foa_thickness m) with

  | 0 ->

   Float_vector_cons ( (matrix_float_demakeup m).(i) )

  | _ ->

   Foa_vector_cons ( (matrix_foa_demakeup m).(i) ) ;;






(** 
matrix_foa_size matrix
 matrix_foa_size works on the superficial layer. 
Inner blocks reduced to a real are accepted.



matrix_foa_size travaille sur la couche superficielle.
Des blocs réduits à un réel sont tolérés. *)


let matrix_foa_size = function (m:float_or_array) ->

 match m with

 | Float_cons x -> Int_vector_cons [| 1 ; 1 |]

 | Float_matrix_cons mm -> Int_vector_cons ( [| Array.length mm ; numcolumns mm |] )

 | _ -> let mm = matrix_foa_demakeup m in

   Int_vector_cons ( [| Array.length mm ; numcolumns mm |] ) ;;






(** 
matrix_foa_rec_size depth matrix
 matrix_foa_rec_size walks 
along the layers up to the desired depth.
Inner blocks reduced to a real are accepted.



matrix_foa_rec_size parcourt les couches jusqu'à la profondeur souhaitée.
Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_rec_size = fun (d:int) (m:float_or_array) ->

 match d with

 | 0 -> matrix_foa_size m 

 | _ ->

  begin

   match m with

    | Float_cons x -> Int_vector_cons [| 1 ; 1 |]

    | Float_matrix_cons x -> matrix_foa_size m

    | _ -> let mm = matrix_foa_demakeup m in

     let r = Array.length mm 

     and c = numcolumns mm in

      let m_m = Array.make_matrix r c (Int_cons 0)

      and cc = c - 1 in 

       for i = 0 to r - 1 do

        let row_input = mm.(i)

        and row_output = m_m.(i) in

         for j = 0 to cc do

          row_output.(j) <- matrix_foa_rec_size ( d - 1 ) row_input.(j)

         done

       done ;

       Ioa_matrix_cons m_m

  end ;;






(** 
vector_foa_affect index element vector
 vector_foa_affect works on the superficial layer.



vector_foa_affect travaille sur la couche superficielle. *)


let vector_foa_affect = fun (index:int) (x:float_or_array) (v:float_or_array) ->

 match (foa_thickness v) with

 | 0 ->

  let vv = vector_float_demakeup v in

   vv.(index) <- float_demakeup x ;

   Float_vector_cons vv

 | _ ->

  let vv = vector_foa_demakeup v in

   vv.(index) <- x ;

   Foa_vector_cons vv ;;






(** 
vector_foa_affect_element position element vector
 vector_foa_affect_element walks 
along the layers following the list of indexes up to the desired depth.



vector_foa_affect_element parcourt les couches en suivant la liste des indices jusqu'à la profondeur souhaitée. *)


let rec vector_foa_affect_element = fun (position:int list)  (x:float_or_array) (v:float_or_array) ->

 match ( List.length position ) with

 | 0 -> failwith "List too short in Matrix.vector_foa_affect_element."

 | 1 -> vector_foa_affect (List.hd position) x v

 | _ ->

  let vv = vector_foa_demakeup v

  and pos = List.hd position in

   vv.(pos) <- vector_foa_affect_element (List.tl position) x vv.(pos) ;

   Foa_vector_cons vv ;;






(** 
matrix_foa_affect index element matrix
 matrix_foa_affect works on the superficial layer.



matrix_foa_affect travaille sur la couche superficielle. *)


let matrix_foa_affect = fun (index:int array) (x:float_or_array) (m:float_or_array) ->

 match (foa_thickness m) with

 | 0 ->

  let mm = matrix_float_demakeup m in

   mm.(index.(0)).(index.(1)) <- float_demakeup x ;

   Float_matrix_cons mm

 | _ ->

  let mm = matrix_foa_demakeup m in

   mm.(index.(0)).(index.(1)) <- x ;

   Foa_matrix_cons mm ;;






(** 
matrix_foa_affect_element position element matrix
 matrix_foa_affect_element walks 
along the layers following the list of indexes up to the desired depth.



matrix_foa_affect_element parcourt les couches en suivant la liste des indices jusqu'à la profondeur souhaitée.*)


let rec matrix_foa_affect_element = fun (position:int array list) (x:float_or_array) (m:float_or_array) ->

 match ( List.length position ) with

 | 0 -> failwith "List too short in Matrix.matrix_foa_affect_element."

 | 1 -> matrix_foa_affect (List.hd position) x m

 | _ ->

  let mm = matrix_foa_demakeup m

  and pos = List.hd position in

   mm.( pos.(0) ).( pos.(1) ) <- matrix_foa_affect_element (List.tl position) x mm.( pos.(0) ).( pos.(1) ) ;

   Foa_matrix_cons mm ;;






(** 
matrix_foa_affect_row index vector matrix
 matrix_foa_affect_row works on the superficial layer.
The size of the vector may be bigger than the number of rows of the matrix.



matrix_foa_affect_row travaille sur la couche superficielle. 
La taille du vecteur peut dépassr le nombre de lignes de la matrice. *)


let matrix_foa_affect_row = fun (index:int) (v:float_or_array) (m:float_or_array) ->

 match (foa_thickness m) with

 | 0 ->

  let mm = matrix_float_demakeup m in

   mm.(index) <- vector_float_demakeup v ;

   Float_matrix_cons mm

 | _ ->

  let mm = matrix_foa_demakeup m in

   mm.(index) <- vector_foa_demakeup v ;

   Foa_matrix_cons mm ;;






(** 
matrix_foa_affect_column index vector matrix
 matrix_foa_affect_column works on the superficial layer.
The size of the vector may be bigger than the number of rows of the matrix.



matrix_foa_affect_column travaille sur la couche superficielle.
La taille du vecteur peut dépassr le nombre de lignes de la matrice. *)


let matrix_foa_affect_column = fun (index:int) (v:float_or_array) (m:float_or_array) ->

 match (foa_thickness m) with

 | 0 ->

  let mm = matrix_float_demakeup m in

   affect_column index (vector_float_demakeup v) mm ;

   Float_matrix_cons mm

 | _ ->

  let mm = matrix_foa_demakeup m in

   let r = Array.length mm in

    for i = 0 to r - 1 do

     mm.(i).(index) <- ( vector_foa_demakeup v ).(i)

    done ;

    Foa_matrix_cons mm ;;






(** 
matrix_foa_find_last element matrix
 matrix_foa_find_last returns [[|-1;-1|]] if it does not find:



matrix_foa_find_last retourne [[|-1;-1|]] s'il ne trouve pas. *)


let rec matrix_foa_find_last = fun (x:float) (m:float_or_array) ->

 match (foa_thickness m) with

 | 0 -> [ matrix_float_find_last x (matrix_float_demakeup m) ]

 | _ ->

  let mm = matrix_foa_demakeup m in

   let r = Array.length mm

   and c = numcolumns mm

   and index = ref ([|-1;-1|]) 

   and suite = ref [] in

    let i = ref ( r - 1 )

    and j = ref ( c - 1 ) in

     while !i >= 0 do

      let row_input = mm.(!i) in

       while !j >= 0 do

        let essaisuite = matrix_foa_find_last x ( row_input.(!j) ) in

         if ( List.hd essaisuite <> [|-1;-1|] ) then 

          begin

           index := [|!i;!j|] ;

           suite := essaisuite ;

           j := -1 ;

           i := -1 ;

          end

        else j := !j - 1 ;

       done ;

       if ( !index = [|-1;-1|] ) then i := !i - 1 ;

      done ;

      !index::!suite ;;






(** 
matrix_foa_find_first element matrix
 matrix_foa_find_first returns [[|-1;-1|]] if it does not find:



matrix_foa_find_first retourne [[|-1;-1|]] s'il ne trouve pas. *)


let rec matrix_foa_find_first = fun (x:float) (m:float_or_array) ->

 match (foa_thickness m) with

 | 0 -> [ matrix_float_find_first x (matrix_float_demakeup m) ]

 | _ ->

  let mm = matrix_foa_demakeup m in

   let r = Array.length mm

   and c = numcolumns mm

   and index = ref ([|-1;-1|]) 

   and suite = ref []

   and i = ref 0 

   and j = ref 0 in

    while !i < r do

     let row_input = mm.(!i) in

      while !j < c do 

       let essaisuite = matrix_foa_find_first x ( row_input.(!j) ) in

        if ( List.hd essaisuite <> [|-1;-1|] ) then 

         begin

          index := [|!i;!j|] ;

          suite := essaisuite ;

          j := c ;

          i := r ;

         end

        else j := !j + 1 ;

      done ;

      if ( !index = [|-1;-1|] ) then i := !i + 1 ;

     done ;

     !index::!suite ;;






(** 
vector_foa_print vector
 *)


let rec vector_foa_print = function (v:float_or_array) ->

 match (foa_thickness v) with

 | 0 -> bare_vector_float_print (vector_float_demakeup v)

 | _ -> let w = vector_foa_demakeup v in

  let rr = (Array.length w) - 1 in

   print_string "[| " ;

   vector_foa_print w.(0) ;

   print_string " ; " ;

   for i = 1 to ( rr - 1 ) do

    vector_foa_print w.(i) ; print_string " ; "

   done ;

   vector_foa_print w.(rr) ;

   print_string " |]" ;;






(** 
matrix_foa_print matrix
 *)


let rec matrix_foa_print = function (m:float_or_array) ->

 match (foa_thickness m) with

 | 0 -> matrix_float_print (matrix_float_demakeup m) 

 | _ -> let w = matrix_foa_demakeup m in

  let r = Array.length w

  and cc = (numcolumns w) - 1 in

   print_string "[| with " ;

   print_int r ;

   print_string " rows" ;

   print_newline () ;

   for i = 0 to r - 1 do

    let row = w.(i) in

     for j = 0 to cc do

      matrix_foa_print row.(j)  

     done ;

   done ;

   print_string "|] and " ;

   print_int (cc + 1) ;

   print_string " columns" ;

   print_newline () ;;








(** 
matrix_ioa_max matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_max = function (m:int_or_array) ->

 match m with

 | Int_cons x -> x

 | Int_matrix_cons u -> matrix_int_max u

 | Ioa_matrix_cons w ->

  begin

   let accu = ref (- max_int) in

    for i = 0 to (Array.length w) - 1 do

     let row = w.(i) in

      for j = 0 to (Array.length row) - 1 do

       accu := Util.int_max !accu ( matrix_ioa_max row.(j) )

      done

    done ;

    !accu

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_max." ;;






(** 
matrix_ioa_min matrix
 Inner blocks reduced to the integer 0 are accepted.



Des blocs réduits à l'entier 0 sont tolérés. *)


let rec matrix_ioa_min = function (m:int_or_array) ->

 match m with

 | Int_cons x -> x

 | Int_matrix_cons u -> matrix_int_min u

 | Ioa_matrix_cons w ->

  begin

   let accu = ref max_int in

    for i = 0 to (Array.length w) - 1 do

     let row = w.(i) in

      for j = 0 to (Array.length row) - 1 do

       accu := min !accu ( matrix_ioa_min row.(j) )

      done

    done ;

    !accu

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_min." ;;






(** 
vector_ioa_find_last element vector
 vector_ioa_find_last returns [-1] if it does not find:



vector_ioa_find_last retourne [-1] s'il ne trouve pas. *)


let rec vector_ioa_find_last = fun (x:int) (v:int_or_array) ->

 match (ioa_thickness v) with

 | 0 -> [ vector_int_find_last x (vector_int_demakeup v) ]

 | _ ->

  let w = vector_ioa_demakeup v in

   let r = Array.length w

   and index = ref (-1) 

   and suite = ref [] in

    let i = ref (r - 1) in

     while !i >= 0 do

      let essaisuite = vector_ioa_find_last x w.(!i) in

       if (List.hd essaisuite <> -1) then 

        begin

         index:= !i ;

         suite := essaisuite ;

         i := -1 ;

        end

       else i := !i - 1 

     done ;

     !index::!suite ;;






(** 
vector_ioa_find_first element vector
 vector_ioa_find_first returns [-1] if it does not find:



vector_ioa_find_first retourne [-1] s'il ne trouve pas. *)


let rec vector_ioa_find_first = fun (x:int) (v:int_or_array) ->

 match (ioa_thickness v) with

 | 0 -> [ vector_int_find_first x (vector_int_demakeup v) ]

 | _ ->

 let w = vector_ioa_demakeup v in

  let r = Array.length w

  and index = ref (-1) 

  and suite = ref [] 

  and i = ref 0 in

   while  !i < r do

    let essaisuite = vector_ioa_find_first x w.(!i) in

     if (List.hd essaisuite <> -1) then 

      begin

       index := !i ;

       suite := essaisuite ;

       i := r ;

      end

     else i := !i + 1 ;

   done ;

  !index::!suite ;;






(** 
vector_ioa_extract_element position vector
 vector_ioa_extract_element walks 
along the layers following the list of indexes up to the desired depth.



vector_ioa_extract_element parcourt les couches en suivant la liste des indices jusqu'à la profondeur souhaitée. *)


let rec vector_ioa_extract_element = fun (pos:int list) (v:int_or_array) ->

 match ( List.length pos ) with

 | 0 -> failwith "List too short in Matrix.vector_ioa_extract_element." 

 | 1 ->

  begin

   match (ioa_thickness v) with

   | 0 -> Int_cons (vector_int_demakeup v).(List.hd pos)

   | _ -> (vector_ioa_demakeup v).(List.hd pos) 

  end

 | _ -> vector_ioa_extract_element (List.tl pos) (vector_ioa_demakeup v).(List.hd pos) ;;






(** 
matrix_ioa_extract_element position matrix
 matrix_ioa_extract_element walks 
along the layers following the list of indexes up to the desired depth.



matrix_ioa_extract_element parcourt les couches en suivant la liste des indices jusqu'à la profondeur souhaitée. *)


let rec matrix_ioa_extract_element = fun (pos:int array list) (m:int_or_array) ->

 match ( List.length pos ) with

 | 0 -> failwith "List too short in Matrix.matrix_ioa_extract_element." 

 | 1 ->

  let index = List.hd pos in

   begin

    match (ioa_thickness m) with

    | 0 -> Int_cons (matrix_int_demakeup m).(index.(0)).(index.(1))

    | _ -> (matrix_ioa_demakeup m).(index.(0)).(index.(1))

   end

 | _ ->

  let index = List.hd pos in

   matrix_ioa_extract_element (List.tl pos) (matrix_ioa_demakeup m).(index.(0)).(index.(1)) ;;






(** 
matrix_ioa_extract_column column matrix
 matrix_ioa_extract_column works on the superficial layer.



matrix_ioa_extract_column travaille sur la couche superficielle. *)


let matrix_ioa_extract_column = fun (i:int) (m:int_or_array) ->

 match (ioa_thickness m) with

  | 0 ->

   let col = extract_column i (matrix_int_demakeup m) in

    Int_vector_cons col

  | _ ->

   let col = extract_column i (matrix_ioa_demakeup m) in

    Ioa_vector_cons col ;;






(** 
matrix_ioa_extract_row row matrix
 matrix_ioa_extract_row works on the superficial layer.



matrix_ioa_extract_row travaille sur la couche superficielle. *)


let matrix_ioa_extract_row = fun (i:int) (m:int_or_array) ->

 match (ioa_thickness m) with

  | 0 ->

   Int_vector_cons ( (matrix_int_demakeup m).(i) )

  | _ ->

   Ioa_vector_cons ( (matrix_ioa_demakeup m).(i) ) ;;






(** 
matrix_ioa_size matrix
 matrix_ioa_size works on the superficial layer. 
Inner blocks reduced to the integer 0 are accepted.



matrix_ioa_size travaille sur la couche superficielle.
Des blocs réduits à l'entier 0 sont tolérés. *)


let matrix_ioa_size = function (m:int_or_array) ->

 match m with

 | Int_cons x -> Int_vector_cons [| 1 ; 1 |]

 | Int_matrix_cons mm -> Int_vector_cons ( [| Array.length mm ; numcolumns mm |] )

 | _ -> let mm = matrix_ioa_demakeup m in

   Int_vector_cons ( [| Array.length mm ; numcolumns mm |] ) ;;






(** 
matrix_ioa_rec_size depth matrix
 matrix_ioa_rec_size walks 
along the layers up to the desired depth.
Inner blocks reduced to the integer 0 are accepted.



matrix_ioa_rec_size parcourt les couches jusqu'à la profondeur souhaitée.
Des blocs réduits à l'entier 0 sont tolérés. *)


let rec matrix_ioa_rec_size = fun (d:int) (m:int_or_array) ->

 match d with

 | 0 -> matrix_ioa_size m

 | _ ->

  begin

   match m with

    | Int_cons x -> Int_vector_cons [| 1 ; 1 |]

    | Int_matrix_cons x -> matrix_ioa_size m

    | _ -> let mm = matrix_ioa_demakeup m in

     let r = Array.length mm 

     and c = numcolumns mm in

      let m_m = Array.make_matrix r c (Int_cons 0)

      and cc = c - 1 in 

       for i = 0 to r - 1 do

        let row_input = mm.(i)

        and row_output = m_m.(i) in

         for j = 0 to cc do

          row_output.(j) <- matrix_ioa_rec_size ( d - 1 ) row_input.(j)

         done

       done ;

       Ioa_matrix_cons m_m

  end ;;






(** 
vector_ioa_affect index element vector
 vector_ioa_affect works on the superficial layer.



vector_ioa_affect travaille sur la couche superficielle. *)


let vector_ioa_affect = fun (index:int) (x:int_or_array) (v:int_or_array) ->

 match (ioa_thickness v) with

 | 0 ->

  let vv = vector_int_demakeup v in

   vv.(index) <- int_demakeup x ;

   Int_vector_cons vv

 | _ ->

  let vv = vector_ioa_demakeup v in

   vv.(index) <- x ;

   Ioa_vector_cons vv ;;






(** 
vector_ioa_affect_element position element vector
 vector_ioa_affect_element walks 
along the layers following the list of indexes up to the desired depth.



vector_ioa_affect_element parcourt les couches en suivant la liste des indices jusqu'à la profondeur souhaitée. *)


let rec vector_ioa_affect_element = fun (position:int list) (x:int_or_array) (v:int_or_array) ->

 match ( List.length position ) with

 | 0 -> failwith "List too short in Matrix.vector_ioa_affect_element."

 | 1 -> vector_ioa_affect (List.hd position) x v

 | _ ->

  let vv = vector_ioa_demakeup v

  and pos = List.hd position in

   vv.(pos) <- vector_ioa_affect_element (List.tl position) x vv.(pos) ;

   Ioa_vector_cons vv ;;






(** 
matrix_ioa_affect index element matrix
 matrix_ioa_affect works on the superficial layer.



matrix_ioa_affect travaille sur la couche superficielle. *)


let matrix_ioa_affect = fun (index:int array) (x:int_or_array) (m:int_or_array) ->

 match (ioa_thickness m) with

 | 0 ->

  let mm = matrix_int_demakeup m in

   mm.(index.(0)).(index.(1)) <- int_demakeup x ;

   Int_matrix_cons mm

 | _ ->

  let mm = matrix_ioa_demakeup m in

   mm.(index.(0)).(index.(1)) <- x ;

   Ioa_matrix_cons mm ;;






(** 
matrix_ioa_affect_element position element matrix
 matrix_ioa_affect_element walks 
along the layers following the list of indexes up to the desired depth.



matrix_ioa_affect_element parcourt les couches en suivant la liste des indices jusqu'à la profondeur souhaitée.*)


let rec matrix_ioa_affect_element = fun (position:int array list) (x:int_or_array) (m:int_or_array) ->

 match ( List.length position ) with

 | 0 -> failwith "List too short in Matrix.matrix_ioa_affect_element."

 | 1 -> matrix_ioa_affect (List.hd position) x m

 | _ ->

  let mm = matrix_ioa_demakeup m

  and pos = List.hd position in

   mm.( pos.(0) ).( pos.(1) ) <- matrix_ioa_affect_element (List.tl position) x mm.( pos.(0) ).( pos.(1) ) ;

   Ioa_matrix_cons mm ;;






(** 
matrix_ioa_affect_row index vector matrix
 matrix_ioa_affect_row works on the superficial layer.
The size of the vector may be bigger than the number of rows of the matrix.



matrix_ioa_affect_row travaille sur la couche superficielle. 
La taille du vecteur peut dépassr le nombre de lignes de la matrice. *)


let matrix_ioa_affect_row = fun (index:int) (v:int_or_array) (m:int_or_array) ->

 match (ioa_thickness m) with

 | 0 ->

  let mm = matrix_int_demakeup m in

   mm.(index) <- vector_int_demakeup v ;

   Int_matrix_cons mm

 | _ ->

  let mm = matrix_ioa_demakeup m in

   mm.(index) <- vector_ioa_demakeup v ;

   Ioa_matrix_cons mm ;;






(** 
matrix_ioa_affect_column index vector matrix
 matrix_ioa_affect_column works on the superficial layer.
The size of the vector may be bigger than the number of rows of the matrix.



matrix_ioa_affect_column travaille sur la couche superficielle.
La taille du vecteur peut dépassr le nombre de lignes de la matrice. *)


let matrix_ioa_affect_column = fun (index:int) (v:int_or_array) (m:int_or_array) ->

 match (ioa_thickness m) with

 | 0 ->

  let mm = matrix_int_demakeup m in

   affect_column index (vector_int_demakeup v) mm ;

   Int_matrix_cons mm

 | _ ->

  let mm = matrix_ioa_demakeup m in

   let r = Array.length mm in

    for i = 0 to r - 1 do

     mm.(i).(index) <- ( vector_ioa_demakeup v ).(i)

    done ;

    Ioa_matrix_cons mm ;;






(** 
matrix_ioa_find_last element matrix
 matrix_ioa_find_last returns [[|-1;-1|]] if it does not find:



matrix_ioa_find_last retourne [[|-1;-1|]] s'il ne trouve pas. *)


let rec matrix_ioa_find_last = fun (x:int) (m:int_or_array) ->

 match (ioa_thickness m) with

 | 0 -> [ matrix_int_find_last x (matrix_int_demakeup m) ]

 | _ ->

  let mm = matrix_ioa_demakeup m in

   let r = Array.length mm

   and c = numcolumns mm

   and index = ref ([|-1;-1|]) 

   and suite = ref [] in

    let i = ref ( r - 1 )

    and j = ref ( c - 1 ) in

     while !i >= 0 do

      let row_input = mm.(!i) in

       while !j >= 0 do

        let essaisuite = matrix_ioa_find_last x ( row_input.(!j) ) in

         if ( List.hd essaisuite <> [|-1;-1|] ) then 

          begin

           index := [|!i;!j|] ;

           suite := essaisuite ;

           j := -1 ;

           i := -1 ;

          end

        else j := !j - 1 ;

       done ;

       if ( !index = [|-1;-1|] ) then i := !i - 1 ;

      done ;

      !index::!suite ;;






(** 
matrix_ioa_find_first element matrix
 matrix_ioa_find_first returns [[|-1;-1|]] if it does not find:



matrix_ioa_find_first retourne [[|-1;-1|]] s'il ne trouve pas. *)


let rec matrix_ioa_find_first = fun (x:int) (m:int_or_array) ->

 match (ioa_thickness m) with

 | 0 -> [ matrix_int_find_first x (matrix_int_demakeup m) ]

 | _ ->

  let mm = matrix_ioa_demakeup m in

   let r = Array.length mm

   and c = numcolumns mm

   and index = ref ([|-1;-1|]) 

   and suite = ref []

   and i = ref 0 

   and j = ref 0 in

    while !i < r do

     let row_input = mm.(!i) in

      while !j < c do 

       let essaisuite = matrix_ioa_find_first x ( row_input.(!j) ) in

        if ( List.hd essaisuite <> [|-1;-1|] ) then 

         begin

          index := [|!i;!j|] ;

          suite := essaisuite ;

          j := c ;

          i := r ;

         end

        else j := !j + 1 ;

      done ;

      if ( !index = [|-1;-1|] ) then i := !i + 1 ;

     done ;

     !index::!suite ;;






(** 
vector_ioa_print vector
 *)


let rec vector_ioa_print = function (v:int_or_array) ->

 match (ioa_thickness v) with

 | 0 -> bare_vector_int_print (vector_int_demakeup v) 

 | _ -> let w = vector_ioa_demakeup v in

  let rr = (Array.length w) - 1 in

   print_string "[| " ;

   vector_ioa_print w.(0) ;

   print_string " ; " ;

   for i = 1 to ( rr - 1 ) do

    vector_ioa_print w.(i) ; print_string " ; "

   done ;

   vector_ioa_print w.(rr) ;

  print_string "|]" ;;






(** 
matrix_ioa_print matrix
 *)


let rec matrix_ioa_print = function (m:int_or_array) ->

 match (ioa_thickness m) with

 | 0 -> matrix_int_print (matrix_int_demakeup m) 

 | _ -> let w = matrix_ioa_demakeup m in

  let r = Array.length w

  and cc = (numcolumns w) - 1 in

   print_string "[| with " ;

   print_int r ;

   print_string " rows" ;

   print_newline () ;

   for i = 0 to r - 1 do

    let row = w.(i) in

     for j = 0 to cc do

      matrix_ioa_print row.(j)  

     done ;

   done ;

   print_string "|] and " ;

   print_int (cc + 1) ;

   print_string " columns" ;

   print_newline () ;;










(** 
§ 
 *)



(**

Calcul élémentaire sur les matrices par blocs
---
Elementary calculus on block matrices
 

*)



(** 
 
 *)











(** 
matrix_foa_scal_add coefficient matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_scal_add = fun (lambda:float) (m:float_or_array) ->

 match m with

 | Float_cons x -> Float_cons ( lambda +. x )

 | Float_matrix_cons u -> Float_matrix_cons ( matrix_float_scal_add lambda u )

 | Foa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Float_cons 0.) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_foa_scal_add lambda row_input.(j) 

       done

     done ;

     Foa_matrix_cons mmm

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_scal_add." ;;






(** 
matrix_foa_scal_mult coefficient matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_scal_mult = fun (lambda:float) (m:float_or_array) ->

 match m with

 | Float_cons x -> Float_cons ( lambda *. x )

 | Float_matrix_cons u -> Float_matrix_cons ( matrix_float_scal_mult lambda u )

 | Foa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Float_cons 0.) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_foa_scal_mult lambda row_input.(j) 

       done

     done ;

     Foa_matrix_cons mmm

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_scal_mult." ;;






(** 
matrix_foa_scal_left_div coefficient matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_scal_left_div = fun (lambda:float) (m:float_or_array) ->

 match m with

 | Float_cons x -> Float_cons ( x /. lambda )

 | Float_matrix_cons u -> Float_matrix_cons ( matrix_float_scal_left_div lambda u )

 | Foa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Float_cons 0.) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_foa_scal_left_div lambda row_input.(j) 

       done

     done ;

     Foa_matrix_cons mmm

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_scal_left_div." ;;






(** 
matrix_foa_scal_right_div coefficient matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_scal_right_div = fun (lambda:float) (m:float_or_array) ->

 match m with

 | Float_cons x -> Float_cons ( lambda /. x )

 | Float_matrix_cons u -> Float_matrix_cons ( matrix_float_scal_right_div lambda u )

 | Foa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Float_cons 0.) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_foa_scal_right_div lambda row_input.(j) 

       done

     done ;

     Foa_matrix_cons mmm

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_scal_right_div." ;;






(** 
matrix_foa_scal_right_sub coefficient matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_scal_right_sub = fun (lambda:float) (m:float_or_array) ->

 match m with

 | Float_cons x -> Float_cons ( x -. lambda )

 | Float_matrix_cons u -> Float_matrix_cons ( matrix_float_scal_right_sub lambda u )

 | Foa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Float_cons 0.) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_foa_scal_right_sub lambda row_input.(j) 

       done

     done ;

     Foa_matrix_cons mmm

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_scal_right_sub." ;;






(** 
matrix_foa_scal_left_sub coefficient matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_scal_left_sub = fun (lambda:float) (m:float_or_array) ->

 match m with

 | Float_cons x -> Float_cons ( lambda -. x )

 | Float_matrix_cons u -> Float_matrix_cons ( matrix_float_scal_left_sub lambda u )

 | Foa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Float_cons 0.) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_foa_scal_left_sub lambda row_input.(j) 

       done

     done ;

     Foa_matrix_cons mmm

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_scal_left_sub." ;;






(** 
matrix_foa_opp matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let matrix_foa_opp = function m ->

 matrix_foa_scal_right_sub 0. m ;;






(** 
matrix_foa_plus matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_plus = fun (m:float_or_array) (mm:float_or_array) ->

 match m with

 | Float_cons x -> matrix_foa_scal_add x mm

 | Float_matrix_cons u ->

  begin

   match mm with 

   | Float_cons y -> Float_matrix_cons ( matrix_float_scal_add y u )

   | _ -> Float_matrix_cons ( matrix_float_plus u ( matrix_float_demakeup mm ) )

  end

 | Foa_matrix_cons w ->

  begin

   match mm with

   | Float_cons y -> matrix_foa_scal_add y m

   | Foa_matrix_cons ww ->

    begin

     let r = Array.length w

     and cc = (numcolumns w) - 1 in

      let z = Array.make_matrix r (cc + 1) (Float_cons 0.) in

       for i = 0 to r - 1 do

        let row_left = w.(i)

        and row_right = ww.(i)

        and row_output = z.(i) in

         for j = 0 to cc do

          row_output.(j) <- matrix_foa_plus row_left.(j) row_right.(j)

         done

       done ;

       Foa_matrix_cons z

    end

   | _ -> failwith "Bad thickness in Matrix.matrix_foa_plus."

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_plus." ;;






(** 
matrix_foa_minus matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_minus = fun (m:float_or_array) (mm:float_or_array) ->

 match m with

 | Float_cons x -> matrix_foa_scal_right_sub x mm

 | Float_matrix_cons u ->

  begin

   match mm with 

   | Float_cons y -> Float_matrix_cons ( matrix_float_scal_left_sub y u )

   | _ -> Float_matrix_cons ( matrix_float_minus u ( matrix_float_demakeup mm ) )

  end

 | Foa_matrix_cons w ->

  begin

   match mm with

   | Float_cons y -> matrix_foa_scal_left_sub y m

   | Foa_matrix_cons ww ->

    begin

     let r = Array.length w

     and cc = (numcolumns w) - 1 in

      let z = Array.make_matrix r (cc + 1) (Float_cons 0.) in

       for i = 0 to r - 1 do

        let row_left = w.(i)

        and row_right = ww.(i)

        and row_output = z.(i) in

         for j = 0 to cc do

          row_output.(j) <- matrix_foa_minus row_left.(j) row_right.(j)

         done

       done ;

       Foa_matrix_cons z

    end

   | _ -> failwith "Bad thickness in Matrix.matrix_foa_minus."

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_minus." ;;






(** 
matrix_foa_coeff_prod matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_coeff_prod = fun (m:float_or_array) (mm:float_or_array) ->

 match m with

 | Float_cons x -> matrix_foa_scal_mult x mm

 | Float_matrix_cons u ->

  begin

   match mm with 

   | Float_cons y -> Float_matrix_cons ( matrix_float_scal_mult y u )

   | _ -> Float_matrix_cons ( matrix_float_coeff_prod u ( matrix_float_demakeup mm ) )

  end

 | Foa_matrix_cons w ->

  begin

   match mm with

   | Float_cons y -> matrix_foa_scal_mult y m

   | Foa_matrix_cons ww ->

    begin

     let r = Array.length w

     and cc = (numcolumns w) - 1 in

      let z = Array.make_matrix r (cc + 1) (Float_cons 0.) in

       for i = 0 to r - 1 do

        let row_left = w.(i)

        and row_right = ww.(i)

        and row_output = z.(i) in

         for j = 0 to cc do

          row_output.(j) <- matrix_foa_coeff_prod row_left.(j) row_right.(j)

         done

       done ;

       Foa_matrix_cons z

    end

   | _ -> failwith "Bad thickness in Matrix.matrix_foa_coeff_prod."

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_coeff_prod." ;;






(** 
matrix_foa_coeff_div matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_coeff_div = fun (m:float_or_array) (mm:float_or_array) ->

 match m with

 | Float_cons x -> matrix_foa_scal_right_div x mm

 | Float_matrix_cons u ->

  begin

   match mm with 

   | Float_cons y -> Float_matrix_cons ( matrix_float_scal_left_div y u )

   | _ -> Float_matrix_cons ( matrix_float_coeff_div u ( matrix_float_demakeup mm ) )

  end

 | Foa_matrix_cons w ->

  begin

   match mm with

   | Float_cons y -> matrix_foa_scal_left_div y m

   | Foa_matrix_cons ww ->

    begin

     let r = Array.length w

     and cc = (numcolumns w) - 1 in

      let z = Array.make_matrix r (cc + 1) (Float_cons 0.) in

       for i = 0 to r - 1 do

        let row_left = w.(i)

        and row_right = ww.(i)

        and row_output = z.(i) in

         for j = 0 to cc do

          row_output.(j) <- matrix_foa_coeff_div row_left.(j) row_right.(j)

         done

       done ;

       Foa_matrix_cons z

    end

   | _ -> failwith "Bad thickness in Matrix.matrix_foa_coeff_div."

  end

 | _ -> failwith "Not a float_or_array matrix in Matrix.matrix_foa_coeff_div." ;;






(** 
foa_transpose matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec foa_transpose = function (m:float_or_array) ->

 match m with

 | Float_cons x -> m

 | Float_matrix_cons w -> Float_matrix_cons ( float_transpose w )

 | _ -> let w = matrix_foa_demakeup m in

  let r = Array.length w

  and cc = (numcolumns w) - 1 in

   let mmm = Array.make_matrix (cc + 1) r (Float_cons 0.) in

    for i = 0 to r - 1 do

     let row_input = w.(i) in

      for j = 0 to cc do

       mmm.(j).(i) <- foa_transpose row_input.(j) 

      done

    done ;

    Foa_matrix_cons mmm ;;






(** 
foa_trace matrix
 foa_trace works on the superficial layer.
Inner blocks reduced to a real number are accepted.



foa_trace travaille sur la couche superficielle.
Des blocs réduits à un réel sont tolérés.  *)


let foa_trace = function (m:float_or_array) ->

 match m with

 | Float_cons x -> m

 | Float_matrix_cons w -> Float_cons ( float_trace w )

 | _ -> let w = matrix_foa_demakeup m in

  let r = min (Array.length w) (numcolumns w)

  and accumulateur = ref (Float_cons 0.) in

   for i = 0 to r - 1 do

    accumulateur := matrix_foa_plus !accumulateur w.(i).(i)    

   done ;

   !accumulateur ;;






(** 
foa_rec_trace matrix
 foa_rec_trace walks along all the layers. 
Inner blocks reduced to a real number are accepted.



foa_rec_trace parcourt toutes les couches.
Des blocs réduits à un réel sont tolérés. *)


let rec foa_rec_trace = function (m:float_or_array) ->

 match m with

 | Float_cons x -> x

 | Float_matrix_cons w -> float_trace w

 | _ -> let w = matrix_foa_demakeup m in

  let r = min (Array.length w) (numcolumns w)

  and accumulateur = ref 0. in

   for i = 0 to r - 1 do

    accumulateur := !accumulateur +. foa_rec_trace w.(i).(i)    

   done ;

   !accumulateur ;;






(** 
line_foa_plus line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let line_foa_plus = fun (s:float_or_array array) (t:float_or_array array) ->

 let r = Array.length s in

  let m = Array.make r (Float_cons 0.) in

   for i = 0 to r - 1 do

    m.(i) <- matrix_foa_plus s.(i) t.(i)

   done ;

   m ;;






(** 
line_foa_minus line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let line_foa_minus = fun (s:float_or_array array) (t:float_or_array array) ->

 let r = Array.length s in

  let m = Array.make r (Float_cons 0.) in

   for i = 0 to r - 1 do

    m.(i) <- matrix_foa_minus s.(i) t.(i)

   done ;

   m ;;






(** 
partial_foa_plus beginning end line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_foa_plus = fun (i:int) (j:int) (s:float_or_array array) (t:float_or_array array) ->

 let c = min (Array.length s) (Array.length t) in

  let m = Array.make c (Float_cons 0.) in

   for k = i to j do

    m.(k) <- matrix_foa_plus s.(k) t.(k)

   done ;

   m ;;






(** 
partial_foa_minus beginning end line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_foa_minus = fun (i:int) (j:int) (s:float_or_array array) (t:float_or_array array) ->

 let c = min (Array.length s) (Array.length t) in

  let m = Array.make c (Float_cons 0.) in

   for k = i to j do

    m.(k) <- matrix_foa_minus s.(k) t.(k)

   done ;

   m ;;






(** 
partial_foa_coeff_prod beginning end line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_foa_coeff_prod = fun (i:int) (j:int) (s:float_or_array array) (t:float_or_array array) ->

 let c = min (Array.length s) (Array.length t) in

  let m = Array.make c (Float_cons 0.) in

   for k = i to j do

    m.(k) <- matrix_foa_coeff_prod s.(k) t.(k)

   done ;

   m ;;






(** 
partial_foa_coeff_div beginning end line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_foa_coeff_div = fun (i:int) (j:int) (s:float_or_array array) (t:float_or_array array) ->

 let c = min (Array.length s) (Array.length t) in

  let m = Array.make c (Float_cons 0.) in

   for k = i to j do

    m.(k) <- matrix_foa_coeff_div s.(k) t.(k)

   done ;

   m ;;






(** 
foa_sym matrix
 *)


let foa_sym = function (m:float_or_array) ->

 matrix_foa_scal_mult 0.5 ( matrix_foa_plus (foa_transpose m) m ) ;;




(** 
foa_antisym matrix
 *)


let foa_antisym = function (m:float_or_array) ->

 matrix_foa_scal_mult 0.5 ( matrix_foa_minus m (foa_transpose m) ) ;;








(** 
matrix_ioa_scal_add coefficient matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_scal_add = fun (lambda:int) (m:int_or_array) ->

 match m with

 | Int_cons x -> Int_cons ( lambda + x )

 | Int_matrix_cons u -> Int_matrix_cons ( matrix_int_scal_add lambda u )

 | Ioa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Int_cons 0) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_ioa_scal_add lambda row_input.(j) 

       done

     done ;

     Ioa_matrix_cons mmm

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_scal_add." ;;






(** 
matrix_ioa_scal_mult coefficient matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_scal_mult = fun (lambda:int) (m:int_or_array) ->

 match m with

 | Int_cons x -> Int_cons ( lambda * x )

 | Int_matrix_cons u -> Int_matrix_cons ( matrix_int_scal_mult lambda u )

 | Ioa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Int_cons 0) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_ioa_scal_mult lambda row_input.(j) 

       done

     done ;

     Ioa_matrix_cons mmm

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_scal_mult." ;;






(** 
matrix_ioa_scal_right_div coefficient matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_scal_right_div = fun (lambda:int) (m:int_or_array) ->

 match m with

 | Int_cons x -> Int_cons ( x / lambda )

 | Int_matrix_cons u -> Int_matrix_cons ( matrix_int_scal_right_div lambda u )

 | Ioa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Int_cons 0) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_ioa_scal_right_div lambda row_input.(j) 

       done

     done ;

     Ioa_matrix_cons mmm

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_scal_right_div." ;;






(** 
matrix_ioa_scal_left_div coefficient matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_scal_left_div = fun (lambda:int) (m:int_or_array) ->

 match m with

 | Int_cons x -> Int_cons ( lambda / x )

 | Int_matrix_cons u -> Int_matrix_cons ( matrix_int_scal_left_div lambda u )

 | Ioa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Int_cons 0) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_ioa_scal_left_div lambda row_input.(j) 

       done

     done ;

     Ioa_matrix_cons mmm

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_scal_left_div." ;;






(** 
matrix_ioa_scal_right_mod coefficient matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_scal_right_mod = fun (lambda:int) (m:int_or_array) ->

 match m with

 | Int_cons x -> Int_cons ( x mod lambda )

 | Int_matrix_cons u -> Int_matrix_cons ( matrix_int_scal_right_mod lambda u )

 | Ioa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Int_cons 0) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_ioa_scal_right_mod lambda row_input.(j) 

       done

     done ;

     Ioa_matrix_cons mmm

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_scal_right_mod." ;;






(** 
matrix_ioa_scal_left_mod coefficient matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_scal_left_mod = fun (lambda:int) (m:int_or_array) ->

 match m with

 | Int_cons x -> Int_cons ( lambda mod x )

 | Int_matrix_cons u -> Int_matrix_cons ( matrix_int_scal_left_mod lambda u )

 | Ioa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Int_cons 0) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_ioa_scal_left_mod lambda row_input.(j) 

       done

     done ;

     Ioa_matrix_cons mmm

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_scal_left_mod." ;;






(** 
matrix_ioa_scal_right_sub coefficient matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_scal_right_sub = fun (lambda:int) (m:int_or_array) ->

 match m with

 | Int_cons x -> Int_cons ( x - lambda )

 | Int_matrix_cons u -> Int_matrix_cons ( matrix_int_scal_right_sub lambda u )

 | Ioa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Int_cons 0) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_ioa_scal_right_sub lambda row_input.(j) 

       done

     done ;

     Ioa_matrix_cons mmm

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_scal_right_sub." ;;






(** 
matrix_ioa_scal_left_sub coefficient matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_scal_left_sub = fun (lambda:int) (m:int_or_array) ->

 match m with

 | Int_cons x -> Int_cons ( lambda - x )

 | Int_matrix_cons u -> Int_matrix_cons ( matrix_int_scal_left_sub lambda u )

 | Ioa_matrix_cons w ->

  begin

   let r = Array.length w

   and cc = (numcolumns w) - 1 in

    let mmm = Array.make_matrix r (cc + 1) (Int_cons 0) in

     for i = 0 to r - 1 do

      let row_output = mmm.(i)

      and row_input = w.(i) in

       for j = 0 to cc do

        row_output.(j) <- matrix_ioa_scal_left_sub lambda row_input.(j) 

       done

     done ;

     Ioa_matrix_cons mmm

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_scal_left_sub." ;;






(** 
matrix_ioa_opp matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let matrix_ioa_opp = function m ->

 matrix_ioa_scal_right_sub 0 m ;;






(** 
matrix_ioa_plus matrix1 matrix2
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_plus = fun (m:int_or_array) (mm:int_or_array) ->

 match m with

 | Int_cons x -> matrix_ioa_scal_add x mm

 | Int_matrix_cons u ->

  begin

   match mm with 

   | Int_cons y -> Int_matrix_cons ( matrix_int_scal_add y u )

   | _ -> Int_matrix_cons ( matrix_int_plus u ( matrix_int_demakeup mm ) )

  end

 | Ioa_matrix_cons w ->

  begin

   match mm with

   | Int_cons y -> matrix_ioa_scal_add y m

   | Ioa_matrix_cons ww ->

    begin

     let r = Array.length w

     and cc = (numcolumns w) - 1 in

      let z = Array.make_matrix r (cc + 1) (Int_cons 0) in

       for i = 0 to r - 1 do

        let row_left = w.(i)

        and row_right = ww.(i)

        and row_output = z.(i) in

         for j = 0 to cc do

          row_output.(j) <- matrix_ioa_plus row_left.(j) row_right.(j)

         done

       done ;

       Ioa_matrix_cons z

    end

   | _ -> failwith "Bad thickness in Matrix.matrix_ioa_plus."

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_plus." ;;






(** 
matrix_ioa_minus matrix1 matrix2
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec matrix_ioa_minus = fun (m:int_or_array) (mm:int_or_array) ->

 match m with

 | Int_cons x -> matrix_ioa_scal_right_sub x mm

 | Int_matrix_cons u ->

  begin

   match mm with 

   | Int_cons y -> Int_matrix_cons ( matrix_int_scal_left_sub y u )

   | _ -> Int_matrix_cons ( matrix_int_minus u ( matrix_int_demakeup mm ) )

  end

 | Ioa_matrix_cons w ->

  begin

   match mm with

   | Int_cons y -> matrix_ioa_scal_left_sub y m

   | Ioa_matrix_cons ww ->

    begin

     let r = Array.length w

     and cc = (numcolumns w) - 1 in

      let z = Array.make_matrix r (cc + 1) (Int_cons 0) in

       for i = 0 to r - 1 do

        let row_left = w.(i)

        and row_right = ww.(i)

        and row_output = z.(i) in

         for j = 0 to cc do

          row_output.(j) <- matrix_ioa_minus row_left.(j) row_right.(j)

         done

       done ;

       Ioa_matrix_cons z

    end

   | _ -> failwith "Bad thickness in Matrix.matrix_ioa_minus."

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_minus." ;;






(** 
matrix_ioa_coeff_prod matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_ioa_coeff_prod = fun (m:int_or_array) (mm:int_or_array) ->

 match m with

 | Int_cons x -> matrix_ioa_scal_mult x mm

 | Int_matrix_cons u ->

  begin

   match mm with 

   | Int_cons y -> Int_matrix_cons ( matrix_int_scal_mult y u )

   | _ -> Int_matrix_cons ( matrix_int_coeff_prod u ( matrix_int_demakeup mm ) )

  end

 | Ioa_matrix_cons w ->

  begin

   match mm with

   | Int_cons y -> matrix_ioa_scal_mult y m

   | Ioa_matrix_cons ww ->

    begin

     let r = Array.length w

     and cc = (numcolumns w) - 1 in

      let z = Array.make_matrix r (cc + 1) (Int_cons 0) in

       for i = 0 to r - 1 do

        let row_left = w.(i)

        and row_right = ww.(i)

        and row_output = z.(i) in

         for j = 0 to cc do

          row_output.(j) <- matrix_ioa_coeff_prod row_left.(j) row_right.(j)

         done

       done ;

       Ioa_matrix_cons z

    end

   | _ -> failwith "Bad thickness in Matrix.matrix_ioa_coeff_prod."

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_coeff_prod." ;;






(** 
matrix_ioa_coeff_div matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_ioa_coeff_div = fun (m:int_or_array) (mm:int_or_array) ->

 match m with

 | Int_cons x -> matrix_ioa_scal_right_div x mm

 | Int_matrix_cons u ->

  begin

   match mm with 

   | Int_cons y -> Int_matrix_cons ( matrix_int_scal_left_div y u )

   | _ -> Int_matrix_cons ( matrix_int_coeff_div u ( matrix_int_demakeup mm ) )

  end

 | Ioa_matrix_cons w ->

  begin

   match mm with

   | Int_cons y -> matrix_ioa_scal_left_div y m

   | Ioa_matrix_cons ww ->

    begin

     let r = Array.length w

     and cc = (numcolumns w) - 1 in

      let z = Array.make_matrix r (cc + 1) (Int_cons 0) in

       for i = 0 to r - 1 do

        let row_left = w.(i)

        and row_right = ww.(i)

        and row_output = z.(i) in

         for j = 0 to cc do

          row_output.(j) <- matrix_ioa_coeff_div row_left.(j) row_right.(j)

         done

       done ;

       Ioa_matrix_cons z

    end

   | _ -> failwith "Bad thickness in Matrix.matrix_ioa_coeff_div."

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_coeff_div." ;;






(** 
matrix_ioa_coeff_mod matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_ioa_coeff_mod = fun (m:int_or_array) (mm:int_or_array) ->

 match m with

 | Int_cons x -> matrix_ioa_scal_left_mod x mm

 | Int_matrix_cons u ->

  begin

   match mm with 

   | Int_cons y -> Int_matrix_cons ( matrix_int_scal_right_mod y u )

   | _ -> Int_matrix_cons ( matrix_int_coeff_mod u ( matrix_int_demakeup mm ) )

  end

 | Ioa_matrix_cons w ->

  begin

   match mm with

   | Int_cons y -> matrix_ioa_scal_right_mod y m

   | Ioa_matrix_cons ww ->

    begin

     let r = Array.length w

     and cc = (numcolumns w) - 1 in

      let z = Array.make_matrix r (cc + 1) (Int_cons 0) in

       for i = 0 to r - 1 do

        let row_left = w.(i)

        and row_right = ww.(i)

        and row_output = z.(i) in

         for j = 0 to cc do

          row_output.(j) <- matrix_ioa_coeff_mod row_left.(j) row_right.(j)

         done

       done ;

       Ioa_matrix_cons z

    end

   | _ -> failwith "Bad thickness in Matrix.matrix_ioa_coeff_mod."

  end

 | _ -> failwith "Not an int_or_array matrix in Matrix.matrix_ioa_coeff_mod." ;;






(** 
ioa_transpose matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec ioa_transpose = function (m:int_or_array) ->

 match m with

 | Int_cons x -> m

 | Int_matrix_cons w -> Int_matrix_cons ( int_transpose w )

 | _ -> let w = matrix_ioa_demakeup m in

  let r = Array.length w

  and cc = (numcolumns w) - 1 in

   let mmm = Array.make_matrix (cc + 1) r (Int_cons 0) in

    for i = 0 to r - 1 do

     let row_input = w.(i) in

      for j = 0 to cc do

       mmm.(j).(i) <- ioa_transpose row_input.(j) 

      done

     done ;

     Ioa_matrix_cons mmm ;;






(** 
ioa_trace matrix
 ioa_trace works on the superficial layer.
Inner blocks reduced to an integer are accepted.



ioa_trace travaille sur la couche superficielle.
Des blocs réduits à un entier sont tolérés. *)


let ioa_trace = function (m:int_or_array) ->

 match m with

 | Int_cons x -> m

 | Int_matrix_cons w -> Int_cons ( int_trace w )

 | _ -> let w = matrix_ioa_demakeup m in

  let r = min (Array.length w) (numcolumns w)

  and accumulateur = ref (Int_cons 0) in

   for i = 0 to r - 1 do

    accumulateur := matrix_ioa_plus !accumulateur w.(i).(i)    

   done ;

   !accumulateur ;;






(** 
ioa_rec_trace matrix
 ioa_rec_trace walks 
along all the layers.
Inner blocks reduced to an integer are accepted.



ioa_rec_trace parcourt toutes les couches.
Des blocs réduits à un entier sont tolérés. *)


let rec ioa_rec_trace = function m ->

 match m with

 | Int_cons x -> x

 | Int_matrix_cons w  -> int_trace w

 | _ -> let w = matrix_ioa_demakeup m in

  let r = min (Array.length w) (numcolumns w)

  and accumulateur = ref 0 in

   for i = 0 to r - 1 do

    accumulateur := !accumulateur + ioa_rec_trace w.(i).(i)    

   done ;

   !accumulateur ;;






(** 
line_ioa_plus line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let line_ioa_plus = fun (s:int_or_array array) (t:int_or_array array) ->

 let r = Array.length s in

  let m = Array.make r (Int_cons 0) in

   for i = 0 to r - 1 do

    m.(i) <- matrix_ioa_plus s.(i) t.(i)

   done ;

   m ;;






(** 
line_ioa_minus line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let line_ioa_minus = fun (s:int_or_array array) (t:int_or_array array) ->

 let r = Array.length s in

  let m = Array.make r (Int_cons 0) in

   for i = 0 to r - 1 do

    m.(i) <- matrix_ioa_minus s.(i) t.(i)

   done ;

   m ;;






(** 
partial_ioa_plus beginning end line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_ioa_plus = fun (i:int) (j:int) (s:int_or_array array) (t:int_or_array array) ->

 let c = min (Array.length s) (Array.length t) in

  let m = Array.make c (Int_cons 0) in

   for k = i to j do

    m.(k) <- matrix_ioa_plus s.(k) t.(k)

   done ;

   m ;;






(** 
partial_ioa_minus beginning end line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_ioa_minus = fun (i:int) (j:int) (s:int_or_array array) (t:int_or_array array) ->

 let c = min (Array.length s) (Array.length t) in

  let m = Array.make c (Int_cons 0) in

   for k = i to j do

    m.(k) <- matrix_ioa_minus s.(k) t.(k)

   done ;

   m ;;






(** 
partial_ioa_coeff_prod beginning end line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_ioa_coeff_prod = fun (i:int) (j:int) (s:int_or_array array) (t:int_or_array array) ->

 let c = min (Array.length s) (Array.length t) in

  let m = Array.make c (Int_cons 0) in

   for k = i to j do

    m.(k) <- matrix_ioa_coeff_prod s.(k) t.(k)

   done ;

   m ;;






(** 
partial_ioa_coeff_div beginning end line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_ioa_coeff_div = fun (i:int) (j:int) (s:int_or_array array) (t:int_or_array array) ->

 let c = min (Array.length s) (Array.length t) in

  let m = Array.make c (Int_cons 0) in

   for k = i to j do

    m.(k) <- matrix_ioa_coeff_div s.(k) t.(k)

   done ;

   m ;;






(** 
partial_ioa_coeff_mod beginning end line1 line2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_ioa_coeff_mod = fun (i:int) (j:int) (s:int_or_array array) (t:int_or_array array) ->

 let c = min (Array.length s) (Array.length t) in

  let m = Array.make c (Int_cons 0) in

   for k = i to j do

    m.(k) <- matrix_ioa_coeff_mod s.(k) t.(k)

   done ;

   m ;;










(** 
§ 
 *)



(**

Construction de matrices par blocs
---
Construction of block matrices
 

*)



(** 
 
 *)











(** 
zeros_foa matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let zeros_foa = function (m:float_or_array) ->

 matrix_foa_scal_mult 0. m ;;






(** 
null_foa numrows numcolumns
 *)


let null_foa = fun (r:int) (c:int) ->

 Foa_matrix_cons ( Array.make_matrix r c (Float_cons 0.) ) ;;






(** 
identity_foa numrows numcolumns
 *)


let identity_foa = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c (Float_cons 0.) in

  for i = 0 to ( min r c ) - 1 do

   m.(i).(i) <- Float_cons 1.

  done ;

  Foa_matrix_cons m ;;






(** 
eye_foa matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec eye_foa = function (m:float_or_array) ->

 match m with

 | Float_cons x -> Float_cons 1.

 | Float_matrix_cons w -> Float_matrix_cons ( identity_float (Array.length w) (Array.length w.(0)) )

 | _ ->

  begin

   let r = foa_numrows m

   and c = foa_numcolumns m

   and mmm = matrix_foa_demakeup m in

    let mm = Array.make_matrix r c (Float_cons 0.) in

     for i = 0 to r - 1 do

      mm.(i).(i) <- eye_foa mmm.(i).(i)

     done ;

     Foa_matrix_cons mm

  end ;;






(** 
scal_foa real matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec scal_foa = fun (lambda:float) (m:float_or_array) ->

 match m with

 | Float_cons x -> Float_cons lambda

 | Float_matrix_cons w -> Float_matrix_cons ( scal_float (Array.length w) (Array.length w.(0)) lambda )

 | _ ->

  begin

   let r = foa_numrows m

   and c = foa_numcolumns m

   and w = matrix_foa_demakeup m in

    let mm = Array.make_matrix r c (Float_cons 0.) in

     for i = 0 to r - 1 do

      mm.(i).(i) <- scal_foa lambda w.(i).(i)

     done ;

     Foa_matrix_cons mm

  end ;;






(** 
diag_foa line
 *)


let diag_foa = function (v:float_or_array array) ->

 let r = Array.length v in

  let w = Array.make_matrix r r (Float_cons 0.) in

   for i = 0 to r - 1 do

    w.(i).(i) <- v.(i)

   done ;

   Foa_matrix_cons w ;;






(** 
matrix_foa_permu size index1 index2
 *)


let matrix_foa_permu = fun (n:int) (i:int) (j:int) ->

 let w = Array.make_matrix n n (Float_cons 0.)

 and ii = min i j

 and jj = Util.int_max i j in

  for k = 0 to ii - 1 do

   w.(k).(k) <- Float_cons 1.

  done ;

  w.(ii).(jj) <- Float_cons 1. ;

  for k = ii + 1 to jj - 1 do

   w.(k).(k) <- Float_cons 1.

  done ;

  w.(jj).(ii) <- Float_cons 1. ;

  for k = jj + 1 to n do

   w.(k).(k) <- Float_cons 1.

  done ;

  Foa_matrix_cons w ;;






(** 
oblique_foa numrows numcolumns
 *)


let oblique_foa = fun (r:int) (c:int) ->

 let w = Array.make_matrix r c (Float_cons 0.)

 and s = ( min r c ) - 1 in

  for i = 0 to s do

   w.(i).(s - i) <- Float_cons 1.

  done ;

  Foa_matrix_cons w ;;






(** 
antiscal_foa numrows numcolumns
 *)


let antiscal_foa = fun (r:int) (c:int) (x:float) ->

 let w = Array.make_matrix r c (Float_cons 0.)

 and s = ( min r c ) - 1 in

  for i = 0 to s do

   w.(i).(s - i) <- Float_cons x

  done ;

  Foa_matrix_cons w ;;






(** 
antidiag_foa line
 *)


let antidiag_foa = function (v:float_or_array array) ->

 let r = Array.length v in

  let w = Array.make_matrix r r (Float_cons 0.) in

   for i = 0 to r - 1 do

    w.(i).(r - 1 - i) <- v.(i)

   done ;

   Foa_matrix_cons w ;;






(** 
gen_sympl_foa
 *)


let gen_sympl_foa =

 Foa_matrix_cons [| [| Float_cons 0. ; Float_cons (-1.) |] ; [| Float_cons 1. ; Float_cons 0. |] |] ;;








(** 
zeros_ioa matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let zeros_ioa = function m ->

 matrix_ioa_scal_mult 0 m ;;






(** 
null_ioa numrows numcolumns
 *)


let null_ioa = fun (r:int) (c:int) ->

 Ioa_matrix_cons ( Array.make_matrix r c (Int_cons 0) ) ;;






(** 
identity_ioa numrows numcolumns
 *)


let identity_ioa = fun (r:int) (c:int) ->

 let m = Array.make_matrix r c (Int_cons 0) in

  for i = 0 to ( min r c ) - 1 do

   m.(i).(i) <- Int_cons 1

  done ;

  Ioa_matrix_cons m ;;






(** 
eye_ioa matrix
 Inner blocks reduced to an integer are accepted.



Des blocs réduits à un entier sont tolérés. *)


let rec eye_ioa = function m ->

 match m with

 | Int_cons x -> Int_cons 1

 | Int_matrix_cons w -> Int_matrix_cons ( identity_int (Array.length w) (Array.length w.(0)) )

 | _ ->

  begin

   let r = ioa_numrows m 

   and c = ioa_numcolumns m

   and mmm = matrix_ioa_demakeup m in

    let mm = Array.make_matrix r c (Int_cons 0) in

     for i = 0 to r - 1 do

      mm.(i).(i) <- eye_ioa mmm.(i).(i)

     done ;

     Ioa_matrix_cons mm

  end ;;






(** 
scal_ioa real matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec scal_ioa = fun (lambda:int) (m:int_or_array) ->

 match m with

 | Int_cons x -> Int_cons lambda

 | Int_matrix_cons w -> Int_matrix_cons ( scal_int (Array.length w) (Array.length w.(0)) lambda )

 | _ ->

  begin

   let r = ioa_numrows m

   and c = ioa_numcolumns m

   and w = matrix_ioa_demakeup m in

    let mm = Array.make_matrix r c (Int_cons 0) in

     for i = 0 to r - 1 do

      mm.(i).(i) <- scal_ioa lambda w.(i).(i)

     done ;

     Ioa_matrix_cons mm

  end ;;






(** 
diag_ioa line matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let diag_ioa = function (v:int_or_array array) ->

 let r = Array.length v in

  let w = Array.make_matrix r r (Int_cons 0) in

   for i = 0 to r - 1 do

    w.(i).(i) <- v.(i)

   done ;

   Ioa_matrix_cons w ;;






(** 
matrix_ioa_permu size index1 index2
 *)


let matrix_ioa_permu = fun (n:int) (i:int) (j:int) ->

 let w = Array.make_matrix n n (Int_cons 0)

 and ii = min i j

 and jj = Util.int_max i j in

  for k = 0 to ii - 1 do

   w.(k).(k) <- Int_cons 1

  done ;

  w.(ii).(jj) <- Int_cons 1 ;

  for k = ii + 1 to jj - 1 do

   w.(k).(k) <- Int_cons 1

  done ;

  w.(jj).(ii) <- Int_cons 1 ;

  for k = jj + 1 to n do

   w.(k).(k) <- Int_cons 1

  done ;

  Ioa_matrix_cons w ;;






(** 
oblique_ioa numrows numcolumns
 *)


let oblique_ioa = fun (r:int) (c:int) ->

 let w = Array.make_matrix r c (Int_cons 0)

 and s = ( min r c ) - 1 in

  for i = 0 to s do

   w.(i).(s - i) <- Int_cons 1

  done ;

  Ioa_matrix_cons w ;;






(** 
antiscal_ioa numrows numcolumns
 *)


let antiscal_ioa = fun (r:int) (c:int) (x:int) ->

 let w = Array.make_matrix r c (Int_cons 0)

 and s = ( min r c ) - 1 in

  for i = 0 to s do

   w.(i).(s - i) <- Int_cons x

  done ;

  Ioa_matrix_cons w ;;






(** 
antidiag_ioa line matrix
 *)


let antidiag_ioa = function (v:int_or_array array) ->

 let r = Array.length v in

  let w = Array.make_matrix r r (Int_cons 0) in

   for i = 0 to r - 1 do

    w.(i).(r - 1 - i) <- v.(i)

   done ;

   Ioa_matrix_cons w ;;






(** 
gen_sympl_ioa
 *)


let gen_sympl_ioa =

 Ioa_matrix_cons [| [| Int_cons 0 ; Int_cons (-1) |] ; [| Int_cons 1 ; Int_cons 0 |] |] ;;










(** 
§ 
 *)



(**

Découpage récursif des matrices par blocs
---
Recursive cutting of block matrices
 

*)



(** 
 
 *)











(** 
hash_threshold number base
 *)


let hash_threshold = fun (n:int) (b:int) ->

 let m = n mod b in

  if m = 0 then 0 else b - m ;;






(** 
square_ioa_hash base matrix sequence
 *)


let rec square_ioa_hash = fun (b:int) (m:int_or_array) (s:int_or_array) ->

 let r = ioa_numrows m

 and c = ioa_numcolumns m in

  let pp = min r c

  and rr = pred r

  and pg = Util.int_max r c in

   match b >= pp with

   | true -> [| matrix_ioa_copy m ; vector_ioa_copy s |]

   | false -> match ioa_thickness m with

    | 0 ->

     begin

      let sequence = ref ( vector_ioa_demakeup s )

      and t = hash_threshold pg b in

       let nouveau = t + pg in

        let morerows = nouveau - r

        and morecolumns = nouveau - c in

         begin

          sequence := Array.append [| Int_vector_cons [| morerows ; morecolumns |] |] !sequence ;

          let mm = ref ( matrix_int_demakeup (matrix_ioa_copy m) ) in

           if morecolumns > 0 then 

            begin

             let terminaison = Array.make morecolumns 0 in

              for i = 0 to rr do

               !mm.(i) <- Array.append !mm.(i) terminaison

              done  

            end ;

           if morerows > 0 then

            begin

             let termin = Array.make_matrix morerows nouveau 0 in

              mm := Array.append !mm termin ; 

              for i = pp to nouveau - 1 do

               !mm.(i).(i) <- 1

              done ;

            end ;

           square_ioa_hash b ( matrix_ioa_cut (nouveau / b) (Int_matrix_cons !mm) ) ( Ioa_vector_cons !sequence )

         end

     end 

    | _ ->

     begin

      let sequence = ref ( vector_ioa_demakeup s )

      and t = hash_threshold pg b in

       let nouveau = t + pg in

        let morerows = nouveau - r

        and morecolumns = nouveau - c in

         begin

          sequence := Array.append [| Int_vector_cons [| morerows ; morecolumns |] |] !sequence ;

          let mm = ref ( matrix_ioa_demakeup m ) in

           if morecolumns > 0 then 

            begin

             let terminaison = Array.make morecolumns (Int_cons 0) in

              for i = 0 to rr do

               !mm.(i) <- Array.append !mm.(i) terminaison

              done  

            end ;

           if morerows > 0 then

            begin

             let termin = Array.make_matrix morerows nouveau (Int_cons 0) in

              mm := Array.append !mm termin ; 

              for i = pp to nouveau - 1 do

               !mm.(i).(i) <- Int_cons 1

              done

            end ;

           square_ioa_hash b ( matrix_ioa_cut (nouveau / b) (Ioa_matrix_cons !mm) ) ( Ioa_vector_cons !sequence )

         end

     end ;;






(** 
square_ioa_crash [| matrix ; sequence |]
 *)


let rec square_ioa_crash = function (data:int_or_array array) ->

 let m = data.(0) and s = vector_ioa_demakeup data.(1) in

  let margin = vector_int_demakeup s.(0) in

   match ioa_thickness m with

   | 0 -> let endrow = (ioa_numrows m) - margin.(0) - 1

    and endcolumn = (ioa_numcolumns m) - margin.(1) - 1

    and t = Array.sub s 1 ( (Array.length s) - 1 ) in

     let matrix = Int_matrix_cons ( int_sub_matrix (matrix_int_demakeup m) 0 endrow 0 endcolumn ) in

      [| matrix ; Ioa_vector_cons t |]

   | 1 -> let mm = matrix_ioa_paste m in

    let endrow = (ioa_numrows mm) - margin.(0) - 1

    and endcolumn = (ioa_numcolumns mm) - margin.(1) - 1

    and t = Array.sub s 1 ( (Array.length s) - 1 ) in

     let matrix = Int_matrix_cons ( int_sub_matrix (matrix_int_demakeup mm) 0 endrow 0 endcolumn ) in

      square_ioa_crash [| matrix ; Ioa_vector_cons t |]

   | _ -> let mm = matrix_ioa_paste m in

    let endrow = (ioa_numrows mm) - margin.(0) - 1

    and endcolumn = (ioa_numcolumns mm) - margin.(1) - 1

    and t = Array.sub s 1 ( (Array.length s) - 1 ) in

     let matrix = Ioa_matrix_cons ( sub_matrix (matrix_ioa_demakeup mm) 0 endrow 0 endcolumn ) in

      square_ioa_crash [| matrix ; Ioa_vector_cons t |] ;;






(** 
square_foa_hash base matrix sequence
 *)


let rec square_foa_hash = fun (b:int) (m:float_or_array) (s:float_or_array) ->

 let r = foa_numrows m

 and c = foa_numcolumns m in

  let pp = min r c

  and rr = pred r

  and pg = Util.int_max r c in

   match b >= pp with

   | true -> [| matrix_foa_copy m ; vector_foa_copy s |]

   | false -> match foa_thickness m with

    | 0 ->

     begin

      let sequence = ref ( vector_foa_demakeup s )

      and t = hash_threshold pg b in

       let nouveau = t + pg in

        let morerows = nouveau - r

        and morecolumns = nouveau - c in

         begin

          sequence := Array.append [| Float_vector_cons [| float morerows ; float morecolumns |] |] !sequence ;

          let mm = ref ( matrix_float_demakeup (matrix_foa_copy m) ) in

           if morecolumns > 0 then 

            begin

             let terminaison = Array.make morecolumns 0. in

              for i = 0 to rr do

               !mm.(i) <- Array.append !mm.(i) terminaison

              done  

            end ;

           if morerows > 0 then

            begin

             let termin = Array.make_matrix morerows nouveau 0. in

              mm := Array.append !mm termin ; 

              for i = pp to nouveau - 1 do

               !mm.(i).(i) <- 1.

              done ;

            end ;

           square_foa_hash b ( matrix_foa_cut (nouveau / b) (Float_matrix_cons !mm) ) ( Foa_vector_cons !sequence )

         end

     end 

    | _ ->

     begin

      let sequence = ref ( vector_foa_demakeup s )

      and t = hash_threshold pg b in

       let nouveau = t + pg in

        let morerows = nouveau - r

        and morecolumns = nouveau - c in

         begin

          sequence := Array.append [| Float_vector_cons [| float morerows ; float morecolumns |] |] !sequence ;

          let mm = ref ( matrix_foa_demakeup m ) in

           if morecolumns > 0 then 

            begin

             let terminaison = Array.make morecolumns (Float_cons 0.) in

              for i = 0 to rr do

               !mm.(i) <- Array.append !mm.(i) terminaison

              done  

            end ;

           if morerows > 0 then

            begin

             let termin = Array.make_matrix morerows nouveau (Float_cons 0.) in

              mm := Array.append !mm termin ; 

              for i = pp to nouveau - 1 do

               !mm.(i).(i) <- Float_cons 1.

              done

            end ;

           square_foa_hash b ( matrix_foa_cut (nouveau / b) (Foa_matrix_cons !mm) ) ( Foa_vector_cons !sequence )

         end

     end ;;






(** 
square_foa_crash [| matrix ; sequence |]
 *)


let rec square_foa_crash = function (data:float_or_array array) ->

 let m = data.(0) and s = vector_foa_demakeup data.(1) in

  let margin = vector_float_demakeup s.(0) in

   match foa_thickness m with

   | 0 -> let endrow = (foa_numrows m) - (int_of_float margin.(0)) - 1

    and endcolumn = (foa_numcolumns m) - (int_of_float margin.(1)) - 1

    and t = Array.sub s 1 ( (Array.length s) - 1 ) in

     let matrix = Float_matrix_cons ( float_sub_matrix (matrix_float_demakeup m) 0 endrow 0 endcolumn ) in

      [| matrix ; Foa_vector_cons t |]

   | 1 -> let mm = matrix_foa_paste m in

    let endrow = (foa_numrows mm) - (int_of_float margin.(0)) - 1

    and endcolumn = (foa_numcolumns mm) - (int_of_float margin.(1)) - 1

    and t = Array.sub s 1 ( (Array.length s) - 1 ) in

     let matrix = Float_matrix_cons ( float_sub_matrix (matrix_float_demakeup mm) 0 endrow 0 endcolumn ) in

      square_foa_crash [| matrix ; Foa_vector_cons t |]

   | _ -> let mm = matrix_foa_paste m in

    let endrow = (foa_numrows mm) - (int_of_float margin.(0)) - 1

    and endcolumn = (foa_numcolumns mm) - (int_of_float margin.(1)) - 1

    and t = Array.sub s 1 ( (Array.length s) - 1 ) in

     let matrix = Foa_matrix_cons ( sub_matrix (matrix_foa_demakeup mm) 0 endrow 0 endcolumn ) in

      square_foa_crash [| matrix ; Foa_vector_cons t |] ;;










(** 
exp_ioa_hash base matrix sequence
 *)


let rec exp_ioa_hash = fun (b:int) (m:int_or_array) (s:int_or_array) ->

 let r = ioa_numrows m

 and c = ioa_numcolumns m in

  let pp = min r c

  and rr = pred r

  and pg = Util.int_max r c in

   match b >= pp with

   | true -> [| matrix_ioa_copy m ; vector_ioa_copy s |]

   | false -> let epaisseur = ioa_thickness m in match epaisseur with

    | 0 ->

     begin

      let sequence = ref ( vector_ioa_demakeup s )

      and t = hash_threshold pg b in

       let nouveau = t + pg in

        let morerows = nouveau - r

        and morecolumns = nouveau - c in

         begin

          sequence := Array.append [| Int_vector_cons [| morerows ; morecolumns |] |] !sequence ;

          let mm = ref ( matrix_int_demakeup (matrix_ioa_copy m) ) in

           if morecolumns > 0 then 

            begin

             let terminaison = Array.make morecolumns (0) in

              for i = 0 to rr do

               !mm.(i) <- Array.append !mm.(i) terminaison

              done  

            end ;

           if morerows > 0 then

            begin

             let termin = Array.make_matrix morerows nouveau (0) in

              mm := Array.append !mm termin ; 

              for i = pp to nouveau - 1 do

               !mm.(i).(i) <- 1

              done ;

            end ;

           exp_ioa_hash b ( matrix_ioa_cut (nouveau / b) (Int_matrix_cons !mm) ) ( Ioa_vector_cons !sequence )

         end

     end 

    | _ ->

     begin

      let sequence = ref ( vector_ioa_demakeup s )

      and t = hash_threshold pg b in

       let nouveau = t + pg in

        let morerows = nouveau - r

        and morecolumns = nouveau - c in

         begin

          sequence := Array.append [| Int_vector_cons [| morerows ; morecolumns |] |] !sequence ;

          let mm = ref ( matrix_ioa_demakeup m ) in

           if morecolumns > 0 then 

            begin

             let terminaison = Array.make morecolumns (Int_cons 0) in

              for i = 0 to rr do

               !mm.(i) <- Array.append !mm.(i) terminaison

              done  

            end ;

           if morerows > 0 then

            begin

             let termin = Array.make_matrix morerows nouveau (Int_cons 0) in

              mm := Array.append !mm termin ; 

              for i = pp to nouveau - 1 do

               !mm.(i).(i) <- Int_cons 1

              done

            end ;

           let fragment = int_of_float ( (float nouveau) /. (float b) ** (float (1 + epaisseur)) ) in

            exp_ioa_hash b ( matrix_ioa_cut (fragment) (Ioa_matrix_cons !mm) ) ( Ioa_vector_cons !sequence )

         end

     end ;;






(** 
exp_foa_hash base matrix sequence
 *)


let rec exp_foa_hash = fun (b:int) (m:float_or_array) (s:float_or_array) ->

 let r = foa_numrows m

 and c = foa_numcolumns m in

  let pp = min r c

  and rr = pred r

  and pg = Util.int_max r c in

   match b >= pp with

   | true -> [| matrix_foa_copy m ; vector_foa_copy s |]

   | false -> let epaisseur = foa_thickness m in match epaisseur with

    | 0 ->

     begin

      let sequence = ref ( vector_foa_demakeup s )

      and t = hash_threshold pg b in

       let nouveau = t + pg in

        let morerows = nouveau - r

        and morecolumns = nouveau - c in

         begin

          sequence := Array.append [| Float_vector_cons [| float morerows ; float morecolumns |] |] !sequence ;

          let mm = ref ( matrix_float_demakeup (matrix_foa_copy m) ) in

           if morecolumns > 0 then 

            begin

             let terminaison = Array.make morecolumns (0.) in

              for i = 0 to rr do

               !mm.(i) <- Array.append !mm.(i) terminaison

              done  

            end ;

           if morerows > 0 then

            begin

             let termin = Array.make_matrix morerows nouveau (0.) in

              mm := Array.append !mm termin ; 

              for i = pp to nouveau - 1 do

               !mm.(i).(i) <- 1.

              done ;

            end ;

           exp_foa_hash b ( matrix_foa_cut (nouveau / b) (Float_matrix_cons !mm) ) ( Foa_vector_cons !sequence )

         end

     end 

    | _ ->

     begin

      let sequence = ref ( vector_foa_demakeup s )

      and t = hash_threshold pg b in

       let nouveau = t + pg in

        let morerows = nouveau - r

        and morecolumns = nouveau - c in

         begin

          sequence := Array.append [| Float_vector_cons [| float morerows ; float morecolumns |] |] !sequence ;

          let mm = ref ( matrix_foa_demakeup m ) in

           if morecolumns > 0 then 

            begin

             let terminaison = Array.make morecolumns (Float_cons 0.) in

              for i = 0 to rr do

               !mm.(i) <- Array.append !mm.(i) terminaison

              done  

            end ;

           if morerows > 0 then

            begin

             let termin = Array.make_matrix morerows nouveau (Float_cons 0.) in

              mm := Array.append !mm termin ; 

              for i = pp to nouveau - 1 do

               !mm.(i).(i) <- Float_cons 1.

              done

            end ;

           let fragment = int_of_float ( (float nouveau) /. (float b) ** (float (1 + epaisseur)) ) in

            exp_foa_hash b ( matrix_foa_cut (fragment) (Foa_matrix_cons !mm) ) ( Foa_vector_cons !sequence )

         end

     end ;;










(** 
§ 
 *)



(**

Calcul substantiel sur les matrices par blocs
---
Substantial calculus on block matrices
 

*)



(** 
 
 *)











(** 
matrix_foa_twisted_prod matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_twisted_prod = fun (m:float_or_array) (mm:float_or_array) ->

 match ( Util.int_max (foa_thickness m) (foa_thickness mm) ) with

 | 0 ->

  begin 
   (** matrices plates --- flat matrices *)


   match m with

   | Float_cons 0. -> Float_cons 0.

   | Float_cons x ->

    begin

     match mm with

     | Float_cons 0. -> Float_cons 0.

     | Float_cons y -> Float_cons (x *. y)

     | _ -> Float_matrix_cons ( matrix_float_scal_mult x ( float_transpose (matrix_float_demakeup mm) ) )

    end

   | _ ->

    begin

     match mm with

     | Float_cons 0. -> Float_cons 0.

     | Float_cons y -> Float_matrix_cons ( matrix_float_scal_mult y (matrix_float_demakeup m) )

     | _ -> Float_matrix_cons ( matrix_float_twisted_prod (matrix_float_demakeup m) (matrix_float_demakeup mm) )

    end

  end 
   (** matrices plates --- flat matrices *)


 | _ ->

  begin 
   (** matrices épaisses --- thick matrices *)


   match m with

   | Float_cons 0. -> Float_cons 0.

   | Float_cons x -> matrix_foa_scal_mult x mm

   | Float_matrix_cons w ->

    begin 
     (** m est plate --- m is flat *)


     let ww = matrix_foa_demakeup mm in

      let r = - 1 + Array.length w

      and c = - 1 + Array.length ww

      and s = - 1 + numcolumns ww in

       let mmm = Array.make_matrix (r + 1) (c + 1) (Float_cons 0.) in

        for i = 0 to r do

         let row_input = w.(i)

         and row_output = mmm.(i) in

          for j = 0 to c do

           let row_right = ww.(j) in

            row_output.(j) <- matrix_foa_scal_mult row_input.(0) ( foa_transpose row_right.(0) ) ;

            for k = 1 to s do

             row_output.(j) <- matrix_foa_plus row_output.(j) ( matrix_foa_scal_mult row_input.(k) ( foa_transpose row_right.(k) ) )

            done

          done

        done ;

        Foa_matrix_cons mmm

    end 
     (** m est plate --- m is flat *)


   | _ ->

    begin 
     (** m est épaisse --- m is thick *)


     match mm with

     | Float_cons 0. -> Float_cons 0.

     | Float_cons y -> matrix_foa_scal_mult y m

     | Float_matrix_cons ww ->

      begin 
       (** mm est plate --- mm is flat *)


       let w = matrix_foa_demakeup m in

        let r = - 1 + Array.length w

        and c = - 1 + Array.length ww

        and s = - 1 + numcolumns ww in

         let mmm = Array.make_matrix (r + 1) (c + 1) (Float_cons 0.) in

          for i = 0 to r do

           let row_input = w.(i)

           and row_output = mmm.(i) in

            for j = 0 to c do

             let row_right = ww.(j) in

              row_output.(j) <- matrix_foa_scal_mult row_right.(0) row_input.(0) ;

              for k = 1 to s do

               row_output.(j) <- matrix_foa_plus row_output.(j) ( matrix_foa_scal_mult row_right.(k) row_input.(k) )

              done

            done

          done ;

          Foa_matrix_cons mmm

      end 
       (** mm est plate --- mm is flat *)


     |_ ->

      begin 
       (** mm est épaisse --- mm is thick *)


       let w = matrix_foa_demakeup m and ww = matrix_foa_demakeup mm in

        let r = - 1 + Array.length w

        and c = - 1 + Array.length ww

        and s = - 1 + numcolumns ww in

         let mmm = Array.make_matrix (r + 1) (c + 1) (Float_cons 0.) in

          for i = 0 to r do

           let row_input = w.(i)

           and row_output = mmm.(i) in

            for j = 0 to c do

             let row_right = ww.(j) in

              row_output.(j) <- matrix_foa_twisted_prod row_input.(0) row_right.(0) ;

              for k = 1 to s do

               row_output.(j) <- matrix_foa_plus row_output.(j) ( matrix_foa_twisted_prod row_input.(k) row_right.(k) )

              done

            done

          done ;

          Foa_matrix_cons mmm

      end 
       (** mm est épaisse --- mm is thick *)


    end 
     (** m est épaisse --- m is thick *)


  end  
    (** matrices épaisses --- thick matrices *)
 ;;






(** 
matrix_foa_prod matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let matrix_foa_prod = fun (m:float_or_array) (mm:float_or_array) ->

 matrix_foa_twisted_prod m ( foa_transpose mm ) ;;




(** 
matrix_foa_triple_prod matrix1 matrix2
 *)


let matrix_foa_triple_prod = fun (a:float_or_array) (b:float_or_array) (c:float_or_array)->

 matrix_foa_twisted_prod a ( matrix_foa_twisted_prod ( foa_transpose c ) b ) ;;






(** 
matrix_foa_twisted_commut matrix1 matrix2
 *)


let matrix_foa_twisted_commut = fun (m:float_or_array) (mm:float_or_array) ->

 matrix_foa_minus ( matrix_foa_twisted_prod m mm ) ( matrix_foa_twisted_prod mm m ) ;;




(** 
matrix_foa_twisted_commut_bis matrix1 matrix2
 *)


let matrix_foa_twisted_commut_bis = fun (m:float_or_array) (mm:float_or_array) ->

 let m_m = foa_transpose m

 and m_mm = foa_transpose mm in

  matrix_foa_minus ( matrix_foa_twisted_prod m mm ) ( matrix_foa_twisted_prod m_mm m_m ) ;;




(** 
matrix_foa_commut matrix1 matrix2
 *)


let matrix_foa_commut = fun (m:float_or_array) (mm:float_or_array) ->

 matrix_foa_minus ( matrix_foa_prod m mm ) ( matrix_foa_prod mm m ) ;;






(** 
matrix_foa_naive_prod matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_naive_prod = fun (m:float_or_array) (mm:float_or_array) ->

 match ( Util.int_max (foa_thickness m) (foa_thickness mm) ) with

 | 0 ->

  begin 
   (** matrices plates --- flat matrices *)


   match m with

   | Float_cons 0. -> Float_cons 0.

   | Float_cons x ->

    begin

     match mm with

     | Float_cons 0. -> Float_cons 0.

     | Float_cons y -> Float_cons (x *. y)

     | _ -> Float_matrix_cons ( matrix_float_scal_mult x (matrix_float_demakeup mm) )

    end

   | _ ->

    begin

     match mm with

     | Float_cons 0. -> Float_cons 0.

     | Float_cons y -> Float_matrix_cons ( matrix_float_scal_mult y (matrix_float_demakeup m) )

     | _ -> Float_matrix_cons ( matrix_float_prod (matrix_float_demakeup m) (matrix_float_demakeup mm) )

    end

  end 
   (** matrices plates --- flat matrices *)


 | _ ->

  begin 
   (** matrices épaisses --- thick matrices *)


   match m with

   | Float_cons 0. -> Float_cons 0.

   | Float_cons x -> matrix_foa_scal_mult x mm

   | Float_matrix_cons w ->

    begin 
     (** m est plate --- m is flat *)


     let ww = matrix_foa_demakeup mm in

      let r = - 1 + Array.length w

      and s = - 1 + Array.length ww

      and c = - 1 + numcolumns ww in

       let mmm = Array.make_matrix (r + 1) (c + 1) (Float_cons 0.) in

        for i = 0 to r do

         let row_input = w.(i)

         and row_output = mmm.(i) in

          for j = 0 to c do

           row_output.(j) <- matrix_foa_scal_mult row_input.(0) ww.(0).(j) ;

           for k = 1 to s do

            row_output.(j) <- matrix_foa_plus row_output.(j) ( matrix_foa_scal_mult row_input.(k) ww.(k).(j) )

           done

          done

        done ;

        Foa_matrix_cons mmm

    end 
     (** m est plate --- m is flat *)


   | _ ->

    begin 
     (** m est épaisse --- m is thick *)


     match mm with

     | Float_cons 0. -> Float_cons 0.

     | Float_cons y -> matrix_foa_scal_mult y m

     | Float_matrix_cons ww ->

      begin 
       (** mm est plate --- mm is flat *)


       let w = matrix_foa_demakeup m in

        let r = - 1 + Array.length w

        and s = - 1 + Array.length ww

        and c = - 1 + numcolumns ww in

         let mmm = Array.make_matrix (r + 1) (c + 1) (Float_cons 0.) in

          for i = 0 to r do

           let row_input = w.(i)

           and row_output = mmm.(i) in

            for j = 0 to c do

             row_output.(j) <- matrix_foa_scal_mult ww.(0).(j) row_input.(0) ;

             for k = 1 to s do

              row_output.(j) <- matrix_foa_plus row_output.(j) ( matrix_foa_scal_mult ww.(k).(j) row_input.(k) )

             done

            done

          done ;

          Foa_matrix_cons mmm

      end 
       (** mm est plate --- mm is flat *)


     |_ ->

      begin 
       (** mm est épaisse --- mm is thick *)


       let w = matrix_foa_demakeup m and ww = matrix_foa_demakeup mm in

        let r = - 1 + Array.length w

        and s = - 1 + Array.length ww

        and c = - 1 + numcolumns ww in

         let mmm = Array.make_matrix (r + 1) (c + 1) (Float_cons 0.) in

          for i = 0 to r do

           let row_input = w.(i)

           and row_output = mmm.(i) in

            for j = 0 to c do

             row_output.(j) <- matrix_foa_naive_prod row_input.(0) ww.(0).(j) ;

             for k = 1 to s do

              row_output.(j) <- matrix_foa_plus row_output.(j) ( matrix_foa_naive_prod row_input.(k) ww.(k).(j) )

             done

            done

          done ;

          Foa_matrix_cons mmm

      end 
       (** mm est épaisse --- mm is thick *)


    end 
     (** m est épaisse --- m is thick *)


  end  
    (** matrices épaisses --- thick matrices *)
 ;;






(** 
matrix_foa_coeff_prod matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_foa_coeff_prod = fun (m:float_or_array) (mm:float_or_array) ->

 match m with

 | Float_cons x -> matrix_foa_scal_mult x m

 | Float_matrix_cons w ->

  begin

   match mm with

   | Float_cons y -> Float_matrix_cons ( matrix_float_scal_mult y w )

   | Float_matrix_cons ww -> Float_matrix_cons ( matrix_float_coeff_prod w ww )

   | _ -> let ww = matrix_foa_demakeup mm in

    let r = Array.length ww

    and cc = ( numcolumns ww ) - 1 in

     for i = 0 to r - 1 do

      for j = 0 to cc do

       ww.(i).(j) <- matrix_foa_scal_mult w.(i).(j) ww.(i).(j)

      done

     done ;

     Foa_matrix_cons ww

  end

 | _ ->

  begin

   match mm with

   | Float_cons y -> matrix_foa_scal_mult y m

   | Float_matrix_cons ww -> matrix_foa_coeff_prod mm m

   | _ -> let ww = matrix_foa_demakeup mm and w = matrix_foa_demakeup m in

    let r = Array.length ww

    and cc = ( numcolumns ww ) - 1 in

     for i = 0 to r - 1 do

      for j = 0 to cc do

       ww.(i).(j) <- matrix_foa_coeff_prod w.(i).(j) ww.(i).(j)

      done

     done ;

     Foa_matrix_cons ww

  end ;;






(** 
foa_diag_left_mult blockVector matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let foa_diag_left_mult = fun (d:foa_strip) (m:float_or_array) ->

 match m with

 | Float_cons y ->

  begin 

   match d with

   | Foa_cons x -> matrix_foa_scal_mult y x

   | _ ->

    begin

     let v = vector_foa_strip_demakeup d in

      let r = Array.length v in

       let mm = Array.make_matrix r r ( Float_cons 0. ) in

        for i = 0 to r - 1 do

         mm.(i).(i) <- matrix_foa_scal_mult y v.(i)

        done ;

        Foa_matrix_cons mm

    end

  end

 | Float_matrix_cons w ->

  begin 

   match d with

   | Foa_cons x -> matrix_foa_prod x m

   | _ ->

    begin

     let v = vector_foa_strip_demakeup d in

      let r = Array.length v

      and cc = numcolumns w in

       let mm = Array.make_matrix r (cc + 1) ( Float_cons 0. ) in

        for i = 0 to r - 1 do

         let row_input = w.(i)

         and row_output = mm.(i)

         and coeff = v.(i) in

          for j = 0 to cc do

           row_output.(j) <- matrix_foa_scal_mult row_input.(j) coeff

          done

        done ;

        Foa_matrix_cons mm

    end

  end

 | _ -> let w = matrix_foa_demakeup m in

  begin

   match d with

   | Foa_cons x -> matrix_foa_prod x m

   | _ ->

    begin

     let v = vector_foa_strip_demakeup d in

      let r = Array.length w

      and cc = ( numcolumns w ) - 1 in

       let mm = Array.make_matrix r (cc + 1) ( Float_cons 0. ) in

        for i = 0 to r - 1 do

         let row_input = w.(i)

         and row_output = mm.(i)

         and coeff = v.(i) in

          for j = 0 to cc do

           row_output.(j) <- matrix_foa_prod coeff row_input.(j)

          done

        done ;

        Foa_matrix_cons mm

    end

  end ;;






(** 
foa_diag_right_mult blockVector matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let foa_diag_right_mult = fun (d:foa_strip) (m:float_or_array) ->

 match m with

 | Float_cons y -> foa_diag_left_mult d m

 | Float_matrix_cons w ->

  begin 

   match d with

   | Foa_cons x -> matrix_foa_prod m x

   | _ -> 
      (** idem foa_diag_left_mult *)


    begin

     let v = vector_foa_strip_demakeup d in

      let r = Array.length v

      and cc = (numcolumns w) - 1 in

       let mm = Array.make_matrix r (cc + 1) ( Float_cons 0. ) in

        for i = 0 to r - 1 do

         let row_input = w.(i)

         and row_output = mm.(i) in

          for j = 0 to cc do

           row_output.(j) <- matrix_foa_scal_mult row_input.(j) v.(j)

          done

        done ;

        Foa_matrix_cons mm

    end

  end

 | _ -> let w = matrix_foa_demakeup m in

  begin

   match d with

   | Foa_cons x -> matrix_foa_prod m x

   | _ ->

    begin

     let v = vector_foa_strip_demakeup d in

      let r = Array.length w

      and cc = ( numcolumns w ) - 1 in

       let mm = Array.make_matrix r (cc + 1) ( Float_cons 0. ) in

        for i = 0 to r - 1 do

         let row_input = w.(i)

         and row_output = mm.(i) in

          for j = 0 to cc do

           row_output.(j) <- matrix_foa_prod row_input.(j) v.(j)

          done

        done ;

        Foa_matrix_cons mm

    end

  end ;;






(** 
partial_foa_left_prod beginning end element line
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_foa_left_prod = fun (i:int) (j:int) (x:float_or_array) (s:float_or_array array) ->

 let c = Array.length s in

  let m = Array.make c (Float_cons 0.) in

   for k = i to j do

    m.(k) <- matrix_foa_prod x s.(k)

   done ;

   m ;;






(** 
partial_foa_left_twisted_prod beginning end element line
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_foa_left_twisted_prod = fun (i:int) (j:int) (x:float_or_array) (s:float_or_array array) ->

 let c = Array.length s in

  let m = Array.make c (Float_cons 0.) in

   for k = i to j do

    m.(k) <- matrix_foa_twisted_prod x s.(k)

   done ;

   m ;;






(** 
partial_foa_right_prod beginning end element line
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_foa_right_prod = fun (i:int) (j:int) (x:float_or_array) (s:float_or_array array) ->

 let c = Array.length s in

  let m = Array.make c (Float_cons 0.) in

   for k = i to j do

    m.(k) <- matrix_foa_prod s.(k) x

   done ;

   m ;;




(** 
partial_foa_right_twisted_prod beginning end element line
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_foa_right_twisted_prod = fun (i:int) (j:int) (x:float_or_array) (s:float_or_array array) ->

 let c = Array.length s in

  let m = Array.make c (Float_cons 0.) in

   for k = i to j do

    m.(k) <- matrix_foa_twisted_prod s.(k) x

   done ;

   m ;;




(** 
other_partial_foa_right_twisted_prod beginning end element line
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let other_partial_foa_right_twisted_prod = fun (i:int) (j:int) (x:float_or_array) (s:float_or_array array) ->

 let c = Array.length s in

  let m = Array.make c (Float_cons 0.) in

   for k = i to j do

    m.(k) <- matrix_foa_twisted_prod ( foa_transpose s.(k) ) x

   done ;

   m ;;








(** 
matrix_ioa_twisted_prod matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_ioa_twisted_prod = fun (m:int_or_array) (mm:int_or_array) ->

 match ( Util.int_max (ioa_thickness m) (ioa_thickness mm) ) with

 | 0 ->

  begin 
   (** matrices plates --- flat matrices *)


   match m with

   | Int_cons 0 -> Int_cons 0

   | Int_cons x ->

    begin

     match mm with

     | Int_cons 0 -> Int_cons 0

     | Int_cons y -> Int_cons (x * y)

     | _ -> Int_matrix_cons ( matrix_int_scal_mult x ( int_transpose (matrix_int_demakeup mm) ) )

    end

   | _ ->

    begin

     match mm with

     | Int_cons 0 -> Int_cons 0

     | Int_cons y -> Int_matrix_cons ( matrix_int_scal_mult y (matrix_int_demakeup m) )

     | _ -> Int_matrix_cons ( matrix_int_twisted_prod (matrix_int_demakeup m) (matrix_int_demakeup mm) )

    end

  end 
   (** matrices plates --- flat matrices *)


 | _ ->

  begin 
   (** matrices épaisses --- thick matrices *)


   match m with

   | Int_cons 0 -> Int_cons 0

   | Int_cons x -> matrix_ioa_scal_mult x mm

   | Int_matrix_cons w ->

    begin 
     (** m est plate --- m is flat *)


     let ww = matrix_ioa_demakeup mm in

      let r = - 1 + Array.length w

      and c = - 1 + Array.length ww

      and s = - 1 + numcolumns ww in

       let mmm = Array.make_matrix (r + 1) (c + 1) (Int_cons 0) in

        for i = 0 to r do

         let row_input = w.(i)

         and row_output = mmm.(i) in

          for j = 0 to c do

           let row_right = ww.(j) in

            row_output.(j) <- matrix_ioa_scal_mult row_input.(0) ( ioa_transpose row_right.(0) ) ;

            for k = 1 to s do

             row_output.(j) <- matrix_ioa_plus row_output.(j) ( matrix_ioa_scal_mult row_input.(k) ( ioa_transpose row_right.(k) ) )

            done

          done

        done ;

        Ioa_matrix_cons mmm

    end 
     (** m est plate --- m is flat *)


   | _ ->

    begin 
     (** m est épaisse --- m is thick *)


     match mm with

     | Int_cons 0 -> Int_cons 0

     | Int_cons y -> matrix_ioa_scal_mult y m

     | Int_matrix_cons ww ->

      begin 
       (** mm est plate --- mm is flat *)


       let w = matrix_ioa_demakeup m in

        let r = - 1 + Array.length w

        and c = - 1 + Array.length ww

        and s = - 1 + numcolumns ww in

         let mmm = Array.make_matrix (r + 1) (c + 1) (Int_cons 0) in

          for i = 0 to r do

           let row_input = w.(i)

           and row_output = mmm.(i) in

            for j = 0 to c do

             let row_right = ww.(j) in

              row_output.(j) <- matrix_ioa_scal_mult row_right.(0) row_input.(0) ;

              for k = 1 to s do

               row_output.(j) <- matrix_ioa_plus row_output.(j) ( matrix_ioa_scal_mult row_right.(k) row_input.(k) )

              done

            done

          done ;

          Ioa_matrix_cons mmm

      end 
       (** mm est plate --- mm is flat *)


     |_ ->

      begin 
       (** mm est épaisse --- mm is thick *)


       let w = matrix_ioa_demakeup m and ww = matrix_ioa_demakeup mm in

        let r = - 1 + Array.length w

        and c = - 1 + Array.length ww

        and s = - 1 + numcolumns ww in

         let mmm = Array.make_matrix (r + 1) (c + 1) (Int_cons 0) in

          for i = 0 to r do

           let row_input = w.(i)

           and row_output = mmm.(i) in

            for j = 0 to c do

             let row_right = ww.(j) in

              row_output.(j) <- matrix_ioa_twisted_prod row_input.(0) row_right.(0) ;

              for k = 1 to s do

               row_output.(j) <- matrix_ioa_plus row_output.(j) ( matrix_ioa_twisted_prod row_input.(k) row_right.(k) )

              done

            done

          done ;

          Ioa_matrix_cons mmm

      end 
       (** mm est épaisse --- mm is thick *)


    end 
     (** m est épaisse --- m is thick *)


  end  
    (** matrices épaisses --- thick matrices *)
 ;;






(** 
matrix_ioa_prod matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let matrix_ioa_prod = fun (m:int_or_array) (mm:int_or_array) ->

 matrix_ioa_twisted_prod m ( ioa_transpose mm ) ;;




(** 
matrix_ioa_triple_prod matrix1 matrix2
 *)


let matrix_ioa_triple_prod = fun (a:int_or_array) (b:int_or_array) (c:int_or_array)->

 matrix_ioa_twisted_prod a ( matrix_ioa_twisted_prod ( ioa_transpose c ) b ) ;;






(** 
matrix_ioa_twisted_commut matrix1 matrix2
 *)


let matrix_ioa_twisted_commut = fun (m:int_or_array) (mm:int_or_array) ->

 matrix_ioa_minus ( matrix_ioa_twisted_prod m mm ) ( matrix_ioa_twisted_prod mm m ) ;;




(** 
matrix_ioa_twisted_commut_bis matrix1 matrix2
 *)


let matrix_ioa_twisted_commut_bis = fun (m:int_or_array) (mm:int_or_array) ->

 let m_m = ioa_transpose m

 and m_mm = ioa_transpose mm in

  matrix_ioa_minus ( matrix_ioa_twisted_prod m mm ) ( matrix_ioa_twisted_prod m_mm m_m ) ;;




(** 
matrix_ioa_commut matrix1 matrix2
 *)


let matrix_ioa_commut = fun (m:int_or_array) (mm:int_or_array) ->

 matrix_ioa_minus ( matrix_ioa_prod m mm ) ( matrix_ioa_prod mm m ) ;;






(** 
matrix_ioa_naive_prod matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_ioa_naive_prod = fun (m:int_or_array) (mm:int_or_array) ->

 match ( Util.int_max (ioa_thickness m) (ioa_thickness mm) ) with

 | 0 ->

  begin 
   (** matrices plates --- flat matrices *)


   match m with

   | Int_cons 0 -> Int_cons 0

   | Int_cons x ->

    begin

     match mm with

     | Int_cons 0 -> Int_cons 0

     | Int_cons y -> Int_cons (x * y)

     | _ -> Int_matrix_cons ( matrix_int_scal_mult x (matrix_int_demakeup mm) )

    end

   | _ ->

    begin

     match mm with

     | Int_cons 0 -> Int_cons 0

     | Int_cons y -> Int_matrix_cons ( matrix_int_scal_mult y (matrix_int_demakeup m) )

     | _ -> Int_matrix_cons ( matrix_int_prod (matrix_int_demakeup m) (matrix_int_demakeup mm) )

    end

  end 
   (** matrices plates --- flat matrices *)


 | _ ->

  begin 
   (** matrices épaisses --- thick matrices *)


   match m with

   | Int_cons 0 -> Int_cons 0

   | Int_cons x -> matrix_ioa_scal_mult x mm

   | Int_matrix_cons w ->

    begin 
     (** m est plate --- m is flat *)


     let ww = matrix_ioa_demakeup mm in

      let r = - 1 + Array.length w

      and s = - 1 + Array.length ww

      and c = - 1 + numcolumns ww in

       let mmm = Array.make_matrix (r + 1) (c + 1) (Int_cons 0) in

        for i = 0 to r do

         let row_input = w.(i)

         and row_output = mmm.(i) in

          for j = 0 to c do

           row_output.(j) <- matrix_ioa_scal_mult row_input.(0) ww.(0).(j) ;

           for k = 1 to s do

            row_output.(j) <- matrix_ioa_plus row_output.(j) ( matrix_ioa_scal_mult row_input.(k) ww.(k).(j) )

           done

          done

        done ;

        Ioa_matrix_cons mmm

    end 
     (** m est plate --- m is flat *)


   | _ ->

    begin 
     (** m est épaisse --- m is thick *)


     match mm with

     | Int_cons 0 -> Int_cons 0

     | Int_cons y -> matrix_ioa_scal_mult y m

     | Int_matrix_cons ww ->

      begin 
       (** mm est plate --- mm is flat *)


       let w = matrix_ioa_demakeup m in

        let r = - 1 + Array.length w

        and s = - 1 + Array.length ww

        and c = - 1 + numcolumns ww in

         let mmm = Array.make_matrix (r + 1) (c + 1) (Int_cons 0) in

          for i = 0 to r do

           let row_input = w.(i)

           and row_output = mmm.(i) in

            for j = 0 to c do

             row_output.(j) <- matrix_ioa_scal_mult ww.(0).(j) row_input.(0) ;

             for k = 1 to s do

              row_output.(j) <- matrix_ioa_plus row_output.(j) ( matrix_ioa_scal_mult ww.(k).(j) row_input.(k) )

             done

            done

          done ;

          Ioa_matrix_cons mmm

      end 
       (** mm est plate --- mm is flat *)


     |_ ->

      begin 
       (** mm est épaisse --- mm is thick *)


       let w = matrix_ioa_demakeup m and ww = matrix_ioa_demakeup mm in

        let r = - 1 + Array.length w

        and s = - 1 + Array.length ww

        and c = - 1 + numcolumns ww in

         let mmm = Array.make_matrix (r + 1) (c + 1) (Int_cons 0) in

          for i = 0 to r do

           let row_input = w.(i)

           and row_output = mmm.(i) in

            for j = 0 to c do

             row_output.(j) <- matrix_ioa_naive_prod row_input.(0) ww.(0).(j) ;

             for k = 1 to s do

              row_output.(j) <- matrix_ioa_plus row_output.(j) ( matrix_ioa_naive_prod row_input.(k) ww.(k).(j) )

             done

            done

          done ;

          Ioa_matrix_cons mmm

      end 
       (** mm est épaisse --- mm is thick *)


    end 
     (** m est épaisse --- m is thick *)


  end  
    (** matrices épaisses --- thick matrices *)
 ;;






(** 
matrix_ioa_coeff_prod matrix1 matrix2
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let rec matrix_ioa_coeff_prod = fun (m:int_or_array) (mm:int_or_array) ->

 match m with

 | Int_cons x -> matrix_ioa_scal_mult x m

 | Int_matrix_cons w ->

  begin

   match mm with

   | Int_cons y -> Int_matrix_cons ( matrix_int_scal_mult y w )

   | Int_matrix_cons ww -> Int_matrix_cons ( matrix_int_coeff_prod w ww )

   | _ -> let ww = matrix_ioa_demakeup mm in

    let r = Array.length ww

    and cc = ( numcolumns ww ) - 1 in

     for i = 0 to r - 1 do

      for j = 0 to cc do

       ww.(i).(j) <- matrix_ioa_scal_mult w.(i).(j) ww.(i).(j)

      done

     done ;

     Ioa_matrix_cons ww

  end

 | _ ->

  begin

   match mm with

   | Int_cons y -> matrix_ioa_scal_mult y m

   | Int_matrix_cons ww -> matrix_ioa_coeff_prod mm m

   | _ -> let ww = matrix_ioa_demakeup mm and w = matrix_ioa_demakeup m in

    let r = Array.length ww

    and cc = ( numcolumns ww ) - 1 in

     for i = 0 to r - 1 do

      for j = 0 to cc do

       ww.(i).(j) <- matrix_ioa_coeff_prod w.(i).(j) ww.(i).(j)

      done

     done ;

     Ioa_matrix_cons ww

  end ;;






(** 
ioa_diag_left_mult blockVector matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let ioa_diag_left_mult = fun (d:ioa_strip) (m:int_or_array) ->

 match m with

 | Int_cons y ->

  begin 

   match d with

   | Ioa_cons x -> matrix_ioa_scal_mult y x

   | _ ->

    begin

     let v = vector_ioa_strip_demakeup d in

      let r = Array.length v in

       let mm = Array.make_matrix r r ( Int_cons 0 ) in

        for i = 0 to r - 1 do

         mm.(i).(i) <- matrix_ioa_scal_mult y v.(i)

        done ;

        Ioa_matrix_cons mm

    end

  end

 | Int_matrix_cons w ->

  begin 

   match d with

   | Ioa_cons x -> matrix_ioa_prod x m

   | _ ->

    begin

     let v = vector_ioa_strip_demakeup d in

      let r = Array.length v

      and cc = numcolumns w in

       let mm = Array.make_matrix r (cc + 1) ( Int_cons 0 ) in

        for i = 0 to r - 1 do

         let row_input = w.(i)

         and row_output = mm.(i)

         and coeff = v.(i) in

          for j = 0 to cc do

           row_output.(j) <- matrix_ioa_scal_mult row_input.(j) coeff

          done

        done ;

        Ioa_matrix_cons mm

    end

  end

 | _ -> let w = matrix_ioa_demakeup m in

  begin

   match d with

   | Ioa_cons x -> matrix_ioa_prod x m

   | _ ->

    begin

     let v = vector_ioa_strip_demakeup d in

      let r = Array.length w

      and cc = ( numcolumns w ) - 1 in

       let mm = Array.make_matrix r (cc + 1) ( Int_cons 0 ) in

        for i = 0 to r - 1 do

         let row_input = w.(i)

         and row_output = mm.(i)

         and coeff = v.(i) in

          for j = 0 to cc do

           row_output.(j) <- matrix_ioa_prod coeff row_input.(j)

          done

        done ;

        Ioa_matrix_cons mm

    end

  end ;;






(** 
ioa_diag_right_mult blockVector matrix
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let ioa_diag_right_mult = fun (d:ioa_strip) (m:int_or_array) ->

 match m with

 | Int_cons y -> ioa_diag_left_mult d m

 | Int_matrix_cons w ->

  begin 

   match d with

   | Ioa_cons x -> matrix_ioa_prod m x

   | _ -> 
      (** idem ioa_diag_left_mult *)


    begin

     let v = vector_ioa_strip_demakeup d in

      let r = Array.length v

      and cc = (numcolumns w) - 1 in

       let mm = Array.make_matrix r (cc + 1) ( Int_cons 0 ) in

        for i = 0 to r - 1 do

         let row_input = w.(i)

         and row_output = mm.(i) in

          for j = 0 to cc do

           row_output.(j) <- matrix_ioa_scal_mult row_input.(j) v.(j)

          done

        done ;

        Ioa_matrix_cons mm

    end

  end

 | _ -> let w = matrix_ioa_demakeup m in

  begin

   match d with

   | Ioa_cons x -> matrix_ioa_prod m x

   | _ ->

    begin

     let v = vector_ioa_strip_demakeup d in

      let r = Array.length w

      and cc = ( numcolumns w ) - 1 in

       let mm = Array.make_matrix r (cc + 1) ( Int_cons 0 ) in

        for i = 0 to r - 1 do

         let row_input = w.(i)

         and row_output = mm.(i) in

          for j = 0 to cc do

           row_output.(j) <- matrix_ioa_prod row_input.(j) v.(j)

          done

        done ;

        Ioa_matrix_cons mm

    end

  end ;;






(** 
partial_ioa_left_prod beginning end element line
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_ioa_left_prod = fun (i:int) (j:int) (x:int_or_array) (s:int_or_array array) ->

 let c = Array.length s in

  let m = Array.make c (Int_cons 0) in

   for k = i to j do

    m.(k) <- matrix_ioa_prod x s.(k)

   done ;

   m ;;






(** 
partial_ioa_right_prod beginning end element line
 Inner blocks reduced to a real number are accepted.



Des blocs réduits à un réel sont tolérés. *)


let partial_ioa_right_prod = fun (i:int) (j:int) (x:int_or_array) (s:int_or_array array) ->

 let c = Array.length s in

  let m = Array.make c (Int_cons 0) in

   for k = i to j do

    m.(k) <- matrix_ioa_prod s.(k) x

   done ;

   m ;;










(** 
§ 
 *)



(** Les définitions des neuf fonctions qui suivent sont mutuellement récursives.



The definitions of the nine following functions are mutually recursive. *)



(** 
 
 *)











(** 
foa_slow_pivot_downward i m p
 The block matrix m is assumed to be upper triangular from line 0 to i - 1.
The matrix p registers the same changes as m.



La matrice par blocs m est supposée, de la ligne 0 à i - 1, triangulaire supérieure. 
La matrice p enregistre les memes changements que m. *)


let rec foa_slow_pivot_downward = fun (i:int) (m:float_or_array) (p:float_or_array) ->

 match m with

 | Float_cons x -> [| m ; Float_cons 1. ; Float_matrix_cons [| [| 0. ; 0. |] |] ; Float_cons (1. /. x) |]

 | Float_matrix_cons w -> let resultat = float_slow_pivot_downward i w (matrix_float_demakeup p) in

  [| Float_matrix_cons resultat.(0) ; Float_matrix_cons resultat.(1) ;

   Float_matrix_cons resultat.(2) ; Float_cons resultat.(3).(0).(0) |]

 | _ ->

  let w = matrix_foa_demakeup m in

   let r = Array.length w

   and mmmm = ref ( matrix_foa_demakeup m )

   and pppp = ref ( matrix_foa_demakeup p )

   and c = numcolumns w in

    let s = min r c 

    and permutation = ref ( [| [| 0. ; 0. |] |] )

    and ww = sub_matrix w i (r - 1) i (c - 1) 

    and index = ref 0

    and k = ref 0 in 

     while !k < Array.length ww do

      if ( foa_slow_invertibility ww.(!k).(0) ) then ( index := !k ; k := r ) else ( k := !k + 1 ) ;

     done ;

      if !index <> 0 then 

       begin

        mmmm := exchange_row i (i + !index) !mmmm ;

        pppp := exchange_row i (i + !index) !pppp ;

       end ;

      let bloc = !mmmm.(i).(i) in

       if not ( foa_slow_invertibility bloc ) then failwith "Block non invertible in Matrix.foa_slow_pivot_downward." ;

       let coefficient = foa_slow_inv bloc in

        let ligne = Array.map (matrix_foa_prod coefficient) !pppp.(i)

        and row = partial_foa_left_prod (i + 1) (c - 1) coefficient !mmmm.(i) in

         for j = i + 1 to s - 1 do 
                    (** Pay attention to order: attention à l'ordre *)


          let coeff = !mmmm.(j).(i) in 

           !pppp.(j) <- line_foa_minus !pppp.(j) ( Array.map (matrix_foa_prod coeff) ligne ) ;

           !mmmm.(j) <- partial_foa_minus (i + 1) (c - 1) !mmmm.(j) ( partial_foa_left_prod (i + 1) (c - 1) coeff row ) ;

         done ;

         [| Foa_matrix_cons !mmmm ; Foa_matrix_cons !pppp ; Float_matrix_cons !permutation ; coefficient |]






(** 
foa_restricted_slow_pivot_downward i m
 The block matrix m is assumed to be upper triangular from line 0 to i - 1.



La matrice par blocs m est supposée, de la ligne 0 à i - 1, triangulaire supérieure. *)


and foa_restricted_slow_pivot_downward = fun (i:int) (m:float_or_array) ->

 match m with

 | Float_cons x -> [| m ; m |]

 | Float_matrix_cons w -> let resultat = float_restricted_slow_pivot_downward i w in

  [| Float_matrix_cons resultat.(0) ; Float_cons resultat.(1).(0).(0) |]

 | _ ->

  let w = matrix_foa_demakeup m in

   let r = Array.length w

   and mmmm = ref w

   and c = numcolumns w in

    let s = min r c 

    and ww = sub_matrix w i (r - 1) i (c - 1) 

    and index = ref 0

    and k = ref 0 in

     while !k < Array.length ww do

      if ( foa_slow_invertibility ww.(!k).(0) ) then ( index := !k ; k := r ) else ( k := !k + 1 ) ;

     done ;

      if !index <> 0 then mmmm := exchange_row i (i + !index) !mmmm ;

      let element = ref !mmmm.(i).(i) in

       if foa_slow_invertibility !element then

        let coefficient = foa_slow_inv !element in

         let row = partial_foa_left_prod (i + 1) (c - 1) coefficient !mmmm.(i) in

          for j = i + 1 to s - 1 do

           let coeff = !mmmm.(j).(i) in 

            !mmmm.(j) <- partial_foa_minus (i + 1) (c - 1) !mmmm.(j) ( partial_foa_left_prod (i + 1) (c - 1) coeff row ) ;

          done

       else element := Float_cons 0. ;

       [| Foa_matrix_cons !mmmm ; !element |]






(** 
foa_slow_pivot_upward i m p
 The block matrix m is assumed to be diagonal from line i + 1 to r - 1.
The matrix p registers the same changes as m.



La matrice par blocs m est supposée, de la ligne i + 1 à r - 1, diagonale. 
La matrice p enregistre les memes changements que m. *)


and foa_slow_pivot_upward = fun (i:int) (m:float_or_array) (p:float_or_array) (coefficient:float_or_array) ->

 match m with

 | Float_cons x -> [| m ; Float_cons 1. |]

 | Float_matrix_cons w -> let resultat = float_slow_pivot_upward i w (matrix_float_demakeup p) (float_demakeup coefficient) in

  [| Float_matrix_cons resultat.(0) ; Float_matrix_cons resultat.(1) |]

 | _ ->

  let mmmm = ref ( matrix_foa_demakeup m )

  and pppp = ref ( matrix_foa_demakeup p ) in

   let ligne = Array.map (matrix_foa_prod coefficient) !pppp.(i)

   and row = partial_foa_left_prod 0 (i - 1) coefficient !mmmm.(i) in

    for j = i - 1 downto 0 do 
             (** Pay attention to order : attention à l'ordre *)


     let coeff = !mmmm.(j).(i) in 

      !pppp.(j) <- line_foa_minus !pppp.(j) ( Array.map (matrix_foa_prod coeff) ligne ) ;

      !mmmm.(j) <- partial_foa_minus j (i - 1) !mmmm.(j) ( partial_foa_left_prod j (i - 1) coeff row ) ;

    done ;

    [| Foa_matrix_cons !mmmm ; Foa_matrix_cons !pppp |]






(** 
foa_slow_invertibility matrix
 *)


and foa_slow_invertibility = function (m:float_or_array) -> match m with

 | Float_cons x -> x <> 0.

 | Float_matrix_cons w -> float_slow_invertibility w

 | _ ->

  let r = min (foa_numrows m) (foa_numcolumns m)

  and mm = ref (matrix_foa_copy m) in

   let i = ref 0

   and rr = pred r

   and output = ref true in

    while !i < rr do

    let resultat = foa_restricted_slow_pivot_downward !i !mm in

     if resultat.(1) = Float_cons 0. then ( i := r ; output := false )

     else

      begin

       mm := resultat.(0) ;

       i := !i + 1 ;

      end

    done ;

   output := !output && ( foa_slow_invertibility ( matrix_foa_demakeup !mm ).(rr).(rr) ) ;

   !output






(** 
foa_slow_invertibility_evaluation matrix
 *)


and foa_slow_invertibility_evaluation = function (m:float_or_array) ->

 match m with

 | Float_cons x -> x

 | Float_matrix_cons w -> float_slow_invertibility_evaluation w

 | _ ->

  let r = min (foa_numrows m) (foa_numcolumns m)

  and mm = ref (matrix_foa_copy m) in

   let i = ref 0

   and rr = pred r

   and diagonale = Array.make r (Float_cons 0.)

   and output = ref max_float in

    while !i < rr do

     let resultat = foa_restricted_slow_pivot_downward !i !mm in

      let coeff = resultat.(1) in

       if ( coeff = Float_cons 0. ) then ( i := r ; output := 0. )

       else

        begin

         mm := resultat.(0) ;

         diagonale.(!i) <- coeff ;

         i := !i + 1 ;

        end

    done ;

    if !output <> 0. then 

     begin

      diagonale.(rr) <- (matrix_foa_demakeup !mm).(rr).(rr) ;

      let suite = Array.map ( foa_slow_invertibility_evaluation ) diagonale in

       let absdiag = vector_float_abs suite in

        let mini = Util.vector_min absdiag in

         let index = vector_float_find_first mini absdiag in

          suite.(index)

     end

    else 0.






(** 
foa_slow_abs_det matrix
 *)


and foa_slow_abs_det = function (m:float_or_array) ->

 match m with

 | Float_cons x -> x

 | Float_matrix_cons w -> abs_float ( float_slow_det w )

 | _ ->

  let r = min (foa_numrows m) (foa_numcolumns m)

  and mm = ref (matrix_foa_copy m)

  and accu = ref 1. in

   let i = ref 0

   and rr = pred r in

    while !i < rr do

     let resultat = foa_restricted_slow_pivot_downward !i !mm in

      let coeff = resultat.(1) in

       if ( coeff = Float_cons 0. ) then ( i := r ; accu := 0. )

       else

        begin

         mm := resultat.(0) ;

         accu := !accu *. ( foa_slow_abs_det coeff ) ;

         i := !i + 1

        end

    done ;

    if !accu <> 0. then

     abs_float ( !accu *. ( foa_slow_abs_det ( matrix_foa_demakeup !mm ).(rr).(rr) ) )

    else 0.






(** 
matrix_foa_slow_left_quotient matrix1 matrix2
 *)


and matrix_foa_slow_left_quotient = fun (m:float_or_array) (q:float_or_array) ->

 match m with

 | Float_cons x -> matrix_foa_scal_left_div x q

 | Float_matrix_cons w -> Float_matrix_cons (matrix_float_slow_left_quotient w ( matrix_float_demakeup q ) )

 | _ ->

  let r = min (foa_numrows m) (foa_numcolumns m)

  and mm = ref ( matrix_foa_copy m )

  and pp = ref ( matrix_foa_copy q ) in

   let diagonale = Array.make r (Float_cons 0.)

   and rr = pred r in

    for i = 0 to r - 2 do

     let resultat = foa_slow_pivot_downward i !mm !pp in

      mm := resultat.(0) ;

      pp := resultat.(1) ;

      diagonale.(i) <- resultat.(3)

    done ;

    let bloc = (matrix_foa_demakeup !mm).(rr).(rr) in

     if not ( foa_slow_invertibility bloc ) then failwith "Block non invertible in Matrix.matrix_foa_slow_left_quotient." ;

     diagonale.(rr) <- foa_slow_inv bloc ;

     for i = rr downto 1 do

      let resultat = foa_slow_pivot_upward i !mm !pp diagonale.(i) in

       mm := resultat.(0) ;

       pp := resultat.(1) ;

     done ;

     mm := foa_diag_left_mult ( Foa_strip_cons diagonale ) !pp ;

     !mm






(** 
line_foa_slow_left_quotient matrix1 matrix_array
 *)


and line_foa_slow_left_quotient = fun (m:float_or_array) (q:float_or_array array) ->

 Array.map ( matrix_foa_slow_left_quotient m ) q






(** 
foa_slow_inv matrix
 *)


and foa_slow_inv = function (m:float_or_array) ->

 match m with

 | Float_cons x -> Float_cons ( 1. /. x )

 | Float_matrix_cons w -> Float_matrix_cons (float_slow_inv w)

 | _ ->

  let r = min (foa_numrows m) (foa_numcolumns m)

  and mm = ref (matrix_foa_copy m)

  and pp = ref (eye_foa m) in

   let diagonale = Array.make r (Float_cons 0.)

   and rr = pred r in

    for i = 0 to r - 2 do

     let resultat = foa_slow_pivot_downward i !mm !pp in

      mm := resultat.(0) ;

      pp := resultat.(1) ;

      diagonale.(i) <- resultat.(3)

    done ;

    let bloc = (matrix_foa_demakeup !mm).(rr).(rr) in

     if not ( foa_slow_invertibility bloc ) then failwith "Block non invertible in Matrix.foa_slow_inv." ;

     diagonale.(rr) <- foa_slow_inv bloc ;

     for i = rr downto 1 do

      let resultat = foa_slow_pivot_upward i !mm !pp diagonale.(i) in

       mm := resultat.(0) ;

       pp := resultat.(1) ;

     done ;

     mm := foa_diag_left_mult ( Foa_strip_cons diagonale ) !pp ;

     !mm ;;










(** Fin des neuf définitions mutuellement récursives.



End of the nine mutually recursive definitions. *)











(** 
matrix_foa_slow_right_quotient matrix1 matrix2
 This gives matrix2 * (matrix1) ^ -1.



Ceci retourne matrix2 * (matrix1) ^ -1. *)


let matrix_foa_slow_right_quotient = fun (m:float_or_array) (q:float_or_array) ->

 foa_transpose ( matrix_foa_slow_left_quotient (foa_transpose m) (foa_transpose q) ) ;;










(** 
§ 
 *)



(** Les définitions des six fonctions qui suivent sont mutuellement récursives.



The definitions of the six following functions are mutually recursive. *)



(** 
 
 *)











(** 
foa_invertibility matrix
 *)


let rec foa_invertibility = function (m:float_or_array) ->

 match m with

 | Float_cons x -> x <> 0.

 | Float_matrix_cons w -> float_invertibility w

 | _ ->

  let w = matrix_foa_demakeup m in

   let r = Array.length w

   and c = numcolumns w

   and i = ref 0

   and output = ref true in

    let rr = r - 1

    and cc = c - 1

    and s = min r c in

     while !i < rr do

      let ii = !i + 1

      and index = ref !i

      and k = ref !i in

       while !k < rr do

        if ( foa_invertibility w.(!k).(!i) ) then ( index := !k ; k := r ) else ( k := !k + 1 ) ;

       done ;

       if !index <> !i then

        begin

         let auxil = w.(!i) in

          w.(!i) <- w.(!index) ;

          w.(!index) <- auxil ;

        end ;

        let element = ref w.(!i).(!i) in

         if ( foa_invertibility !element ) then

          let coefficient = foa_inv !element in

           let row = other_partial_foa_right_twisted_prod ii cc coefficient w.(!i) in

            for j = ii to s - 1 do

             let coeff = w.(j).(!i) in 

              w.(j) <- partial_foa_minus ii cc w.(j) ( partial_foa_left_twisted_prod ii cc coeff row ) ;

            done ;

            i := ii

         else ( i := r ; output := false ) ;

     done ;

     output := !output && ( foa_invertibility w.(rr).(rr) ) ;

     !output






(** 
foa_invertibility_evaluation matrix
 *)


and foa_invertibility_evaluation = function (m:float_or_array) ->

 match m with

 | Float_cons x -> x

 | Float_matrix_cons w -> float_invertibility_evaluation w

 | _ ->

  let w = matrix_foa_demakeup m in

   let r = Array.length w

   and c = numcolumns w

   and i = ref 0 in

    let rr = r - 1

    and cc = c - 1

    and s = min r c

    and diagonale = Array.make r 0.

    and output = ref max_float in

     while !i < rr do

      let ii = !i + 1

      and index = ref !i

      and k = ref !i in

       while !k < rr do

        if ( foa_invertibility w.(!k).(!i) ) then ( index := !k ; k := r ) else ( k := !k + 1 ) ;

       done ;

       if !index <> !i then

        begin

         let auxil = w.(!i) in

          w.(!i) <- w.(!index) ;

          w.(!index) <- auxil ;

        end ;

        let element = ref w.(!i).(!i) in

         if ( foa_invertibility !element ) then

          begin

           diagonale.(!i) <- foa_invertibility_evaluation !element ;

           let coefficient = foa_inv !element in

            let row = other_partial_foa_right_twisted_prod ii cc coefficient w.(!i) in

             for j = ii to s - 1 do

              let coeff = w.(j).(!i) in 

               w.(j) <- partial_foa_minus ii cc w.(j) ( partial_foa_left_twisted_prod ii cc coeff row ) ;

             done ;

             i := ii

          end

         else ( i := r ; output := 0. ) ;

     done ;

     if !output <> 0. then 

      begin

       diagonale.(rr) <- foa_invertibility_evaluation w.(rr).(rr) ;

        let absdiag = vector_float_abs diagonale in

        let mini = Util.vector_min absdiag in

         let index = vector_float_find_first mini absdiag in

          diagonale.(index)

      end

     else 0.






(** 
foa_abs_det matrix
 *)


and foa_abs_det = function (m:float_or_array) ->

 match m with

 | Float_cons x -> abs_float x

 | Float_matrix_cons w -> abs_float ( float_det w )

 | _ ->

  let w = matrix_foa_demakeup m in

   let r = Array.length w

   and c = numcolumns w

   and i = ref 0 in

    let rr = r - 1

    and cc = c - 1

    and s = min r c

    and accu = ref 1. in

     while !i < rr do

      let ii = !i + 1

      and index = ref !i

      and k = ref !i in

       while !k < rr do

        if ( foa_invertibility w.(!k).(!i) ) then ( index := !k ; k := r ) else ( k := !k + 1 ) ;

       done ;

       if !index <> !i then

        begin

         let auxil = w.(!i) in

          w.(!i) <- w.(!index) ;

          w.(!index) <- auxil ;

        end ;

        let element = ref w.(!i).(!i) in

         if ( foa_invertibility !element ) then

          begin

           accu := !accu *. ( foa_abs_det !element ) ;

           let coefficient = foa_inv !element in

            let row = other_partial_foa_right_twisted_prod ii cc coefficient w.(!i) in

             for j = ii to s - 1 do

              let coeff = w.(j).(!i) in 

               w.(j) <- partial_foa_minus ii cc w.(j) ( partial_foa_left_twisted_prod ii cc coeff row ) ;

             done ;

             i := ii

          end

         else ( i := r ; accu := 0. ) ;

     done ;

     if !accu <> 0. then 

      !accu *. ( foa_abs_det w.(rr).(rr) )

     else 0.






(** 
matrix_foa_left_quotient matrix1 matrix2
 *)


and matrix_foa_left_quotient = fun (m:float_or_array) (q:float_or_array) ->

 match m with

 | Float_cons x -> matrix_foa_scal_mult ( 1. /. x ) q

 | Float_matrix_cons w -> Float_matrix_cons ( matrix_float_left_quotient w (matrix_float_demakeup q) )

 | _ ->

  let w = matrix_foa_demakeup m

  and p = matrix_foa_demakeup q in

   let r = Array.length w

   and c = numcolumns w in

    let rr = r - 1

    and cc = c - 1

    and index = ref 0

    and diagonale = Array.make r (Float_cons 0.) in

     for i = 0 to r - 2 do

      let ii = i + 1

      and k = ref i in

       while !k < r do

        if (foa_invertibility w.(!k).(i) = true) then ( index := !k ; k := r ) else ( k := !k + 1 ) ;

       done ;

       if !index <> i then 

        begin

         let auxil = w.(i)

         and aux = p.(i) in

          w.(i) <- w.( !index ) ;

          w.( !index ) <- auxil ;

          p.(i) <- p.( !index ) ;

          p.( !index ) <- aux

        end ;

        let bloc = w.(i).(i) in

         if not ( foa_invertibility bloc ) then failwith "Block non invertible in Matrix.matrix_foa_left_quotient." ;

         let coefficient = foa_inv bloc in

          let ligne = Array.map (function x -> matrix_foa_twisted_prod (foa_transpose x) coefficient) p.(i)

          and row = other_partial_foa_right_twisted_prod ii cc coefficient w.(i) in

           for j = ii to rr do 
                  (** Pay attention to order: attention à l'ordre *)


             let coeff = w.(j).(i) in 

             p.(j) <- line_foa_minus p.(j) ( Array.map (matrix_foa_twisted_prod coeff) ligne ) ;

             w.(j) <- partial_foa_minus ii cc w.(j) ( partial_foa_left_twisted_prod ii cc coeff row ) ;

           done ;

           diagonale.(i) <- coefficient ;

     done ;

     let bloc = w.(rr).(rr) in

      if not ( foa_invertibility bloc ) then failwith "Last block non invertible in Matrix.matrix_foa_left_quotient." ;

      diagonale.(rr) <- foa_inv bloc ;

      for i = rr downto 1 do

       let coefficient = diagonale.(i)

       and iii = i - 1 in

        let ligne = Array.map (function x -> matrix_foa_twisted_prod (foa_transpose x) coefficient) p.(i) in

         for j = iii downto 0 do 
                (** Pay attention to order: attention à l'ordre *)


          let coeff = w.(j).(i) in 

           p.(j) <- line_foa_minus p.(j) ( Array.map (matrix_foa_twisted_prod coeff) ligne ) ;

         done ;

      done ;

      foa_diag_left_mult ( Foa_strip_cons diagonale ) ( Foa_matrix_cons p )






(** 
line_foa_left_quotient matrix1 matrix_array
 *)


and line_foa_left_quotient = fun (m:float_or_array) (q:float_or_array array) ->

 Array.map (matrix_foa_left_quotient m) q






(** 
foa_inv matrix
 *)


and foa_inv = function (m:float_or_array) ->

 match m with

 | Float_cons x -> Float_cons ( 1. /. x )

 | Float_matrix_cons w -> Float_matrix_cons (float_inv w)

 | _ ->

  let w = matrix_foa_demakeup m

  and p = matrix_foa_demakeup ( eye_foa m ) in

   let r = Array.length w

   and c = numcolumns w in

    let rr = r - 1

    and cc = c - 1

    and index = ref 0

    and diagonale = Array.make r (Float_cons 0.) in

     for i = 0 to r - 2 do

      let ii = i + 1

      and k = ref i in

       while !k < r do

        if (foa_invertibility w.(!k).(i) = true) then ( index := !k ; k := r ) else ( k := !k + 1 ) ;

       done ;

       if !index <> i then 

        begin

         let auxil = w.(i)

         and aux = p.(i) in

          w.(i) <- w.( !index ) ;

          w.( !index ) <- auxil ;

          p.(i) <- p.( !index ) ;

          p.( !index ) <- aux

        end ;

        let bloc = w.(i).(i) in

         if not ( foa_invertibility bloc ) then failwith "Block non invertible in Matrix.foa_inv." ;

         let coefficient = foa_inv bloc in

          let ligne = Array.map (function x -> matrix_foa_twisted_prod (foa_transpose x) coefficient) p.(i)

          and row = other_partial_foa_right_twisted_prod ii cc coefficient w.(i) in

           for j = ii to rr do 
                  (** Pay attention to order: attention à l'ordre *)


            let coeff = w.(j).(i) in 

             p.(j) <- line_foa_minus p.(j) ( Array.map (matrix_foa_twisted_prod coeff) ligne ) ;

             w.(j) <- partial_foa_minus ii cc w.(j) ( partial_foa_left_twisted_prod ii cc coeff row ) ;

           done ;

           diagonale.(i) <- coefficient ;

     done ;

     let bloc = w.(rr).(rr) in

      if not ( foa_invertibility bloc ) then failwith "Last block non invertible in Matrix.foa_inv." ;

      diagonale.(rr) <- foa_inv bloc ;

      for i = rr downto 1 do

       let coefficient = diagonale.(i)

       and iii = i - 1 in

        let ligne = Array.map (function x -> matrix_foa_twisted_prod (foa_transpose x) coefficient) p.(i) in

         for j = iii downto 0 do 
                (** Pay attention to order: attention à l'ordre *)


          let coeff = w.(j).(i) in 

           p.(j) <- line_foa_minus p.(j) ( Array.map (matrix_foa_twisted_prod coeff) ligne ) ;

         done ;

      done ;

      foa_diag_left_mult ( Foa_strip_cons diagonale ) ( Foa_matrix_cons p ) ;;










(** Fin des six définitions mutuellement récursives.



End of the six mutually recursive definitions. *)











(** 
matrix_foa_right_quotient matrix1 matrix2
 This gives matrix2 * (matrix1) ^ -1.



Ceci retourne matrix2 * (matrix1) ^ -1. *)


let matrix_foa_right_quotient = fun (m:float_or_array) (q:float_or_array) ->

 foa_transpose ( matrix_foa_left_quotient (foa_transpose m) (foa_transpose q) ) ;;






(** 
line_foa_right_quotient matrix1 matrix_array
 *)


let line_foa_right_quotient = fun (m:float_or_array) (q:float_or_array array) ->

 Array.map (matrix_foa_right_quotient m) q ;;










(** 
§ 
 *)



(**

Expérimentations par découpage des matrices plates
---
Experimentations with cutting of flat matrices
 

*)



(** 
 
 *)











(** 
special_exponent size
 *)


let special_exponent = function r ->

  let s = 1. /. ( max 1. (log r) ) in

   0.45 *. s +. (1. -. s) *. 1.29 /. ( max 2. (log10 r) ) ;;








(** 
square_float_slow_inv base matrix
 *)


let square_float_slow_inv = fun b m ->

 let debut = ( Foa_vector_cons [| Float_vector_cons [|0.;0.|] |] ) in

  let mm = square_foa_hash b (Float_matrix_cons m) debut in

   let mmm = foa_slow_inv mm.(0) in

    let mmmm = square_foa_crash [| mmm ; mm.(1) |] in

     matrix_float_demakeup mmmm.(0) ;;




(** 
exp_float_slow_inv base matrix
 *)


let exp_float_slow_inv = fun b m ->

 let debut = ( Foa_vector_cons [| Float_vector_cons [|0.;0.|] |] ) in

  let mm = exp_foa_hash b (Float_matrix_cons m) debut in

   let mmm = foa_slow_inv mm.(0) in

    let mmmm = square_foa_crash [| mmm ; mm.(1) |] in

     matrix_float_demakeup mmmm.(0) ;;




(** 
sqrt_float_slow_inv matrix
 *)


let sqrt_float_slow_inv = function m ->

 let b = 10 + int_of_float ( ceil ( sqrt ( float (numrows m) ) ) )

 and debut = ( Foa_vector_cons [| Float_vector_cons [|0.;0.|] |] ) in

  let mm = square_foa_hash b (Float_matrix_cons m) debut in

   let mmm = foa_slow_inv mm.(0) in

    let mmmm = square_foa_crash [| mmm ; mm.(1) |] in

     matrix_float_demakeup mmmm.(0) ;;




(** 
alpha_float_slow_inv matrix
 *)


let alpha_float_slow_inv = function m ->

 let r = float (numrows m) in

  let alpha = special_exponent r

   and seuil = 10. in

    let b = int_of_float ( ceil ( seuil *. ( r /. seuil ) ** alpha ) )

    and debut = ( Foa_vector_cons [| Float_vector_cons [|0.;0.|] |] ) in

     let mm = exp_foa_hash b (Float_matrix_cons m) debut in

      let mmm = foa_slow_inv mm.(0) in

       let mmmm = square_foa_crash [| mmm ; mm.(1) |] in

        matrix_float_demakeup mmmm.(0) ;;








(** 
square_float_inv base matrix
 *)


let square_float_inv = fun b m ->

 let debut = Foa_vector_cons [| Float_vector_cons [|0.;0.|] |] in

  let mm = square_foa_hash b (Float_matrix_cons m) debut in

   let mmm = foa_inv mm.(0) in

    let mmmm = square_foa_crash [| mmm ; mm.(1) |] in

     matrix_float_demakeup mmmm.(0) ;;




(** 
exp_float_inv base matrix
 *)


let exp_float_inv = fun b m ->

 let debut = Foa_vector_cons [| Float_vector_cons [|0.;0.|] |] in

  let mm = exp_foa_hash b (Float_matrix_cons m) debut in

   let mmm = foa_inv mm.(0) in

    let mmmm = square_foa_crash [| mmm ; mm.(1) |] in

     matrix_float_demakeup mmmm.(0) ;;




(** 
sqrt_float_inv matrix
 *)


let sqrt_float_inv = function m ->

 let b = 10 + int_of_float ( ceil ( sqrt ( float (numrows m) ) ) )

 and debut = Foa_vector_cons [| Float_vector_cons [|0.;0.|] |] in

  let mm = square_foa_hash b (Float_matrix_cons m) debut in

   let mmm = foa_inv mm.(0) in

    let mmmm = square_foa_crash [| mmm ; mm.(1) |] in

     matrix_float_demakeup mmmm.(0) ;;








(** 
beta_float_inv matrix
 *)


let beta_float_inv = function m ->

 let b = int_of_float ( 0.4 *. sqrt ( float (Array.length m) ) ) in

  let mm = matrix_float_cut b m in

   let mmm = foa_inv mm.(0) in

    matrix_float_crash [| mmm ; mm.(1) |] ;;




(** 
gamma_float_inv matrix
 *)


let gamma_float_inv = function m ->


(** let b = int_of_float ( 0.4 *. sqrt ( float (Array.length m) ) ) in *)


 let r = Array.length m in

  if r < 2000 then float_inv m

  else

   begin

    let b = int_of_float ( ( float (Array.length m) ) /. 70. ) in

     let mm = matrix_float_cut b m

      and debut = [| Float_vector_cons [|0.;0.|] |] in

       let ww = square_foa_hash 8 mm.(0) ( Foa_vector_cons ( Array.append (vector_foa_demakeup mm.(1)) debut ) ) in

        let mmm = foa_inv ww.(0) in

         let mmmm = square_foa_crash [| mmm ; ww.(1) |] in

          matrix_float_demakeup mmmm.(0)

   end ;;




(** 
delta_float_inv matrix
 *)


let delta_float_inv = function m ->

 let r = Array.length m in

  if r < 1250 then float_inv m

  else 
   (** ordre = 1250 : réduction de l' exposant qui compense l'augmentation de C dans : << temps ( n ) ~= C * ( n ** exposant ) >> *)


   begin

    let rr = float r in

     let alpha = special_exponent rr in

      let b = int_of_float ( floor ( rr ** alpha ) ) in

       let mm = matrix_float_cut b m in

        let mmm = foa_inv mm.(0) in

         matrix_float_crash [| mmm ; mm.(1) |]

   end ;;










(** 
§ 
 *)



(**

Fonctions et constructions supplémentaires
---
Further functions and constructions
 

*)



(** 
 
 *)











(** 
critical_order
 Order = 1250: reduction of the exponent which compensates
the augmentation of C in:
<< duration ( n ) ~= C * ( n ** exponent ) >>



Ordre = 1250 : réduction de l' exposant qui compense l'augmentation de C dans : 
<< temps ( n ) ~= C * ( n ** exposant ) >> *)


let critical_order = 1250 ;;




(** 
generic_float_inv matrix
 For big ordres, the matrix must be invertible by blocks. 
This is achieved for some matrices obtained from the random float generator of Ocaml.



Pour de grands ordres, la matrice doit être bloc-inversible.
C'est vérifié pour certaines matrices construites à partir du générateur aléatoire de réels d'Ocaml. *)


let generic_float_inv = function m ->

 let r = Array.length m in

  if r < critical_order then float_inv m

  else

   begin

    let rr = float r in

     let alpha = special_exponent rr in

      let b = int_of_float ( floor ( rr ** alpha ) ) in

       let mm = matrix_float_cut b m in

        let mmm = foa_inv mm.(0) in

         matrix_float_crash [| mmm ; mm.(1) |]

   end ;;






(** 
generic_float_invertibility matrix
 For big ordres, the matrix must be invertible by blocks. 
This is achieved for some matrices obtained from the random float generator of Ocaml.



Pour de grands ordres, la matrice doit être bloc-inversible.
C'est vérifié pour certaines matrices construites à partir du générateur aléatoire de réels d'Ocaml. *)


let generic_float_invertibility = function m ->

 let r = Array.length m in

  if r < critical_order then float_invertibility m

  else

   begin

    let rr = float r in

     let alpha = special_exponent rr in

      let b = int_of_float ( floor ( rr ** alpha ) ) in

       let mm = matrix_float_cut b m in

        foa_invertibility mm.(0)

   end ;;






(** 
generic_float_invertibility_evaluation matrix
 For big ordres, the matrix must be invertible by blocks. 
This is achieved for some matrices obtained from the random float generator of Ocaml.



Pour de grands ordres, la matrice doit être bloc-inversible.
C'est vérifié pour certaines matrices construites à partir du générateur aléatoire de réels d'Ocaml. *)


let generic_float_invertibility_evaluation = function m ->

 let r = Array.length m in

  if r < critical_order then float_invertibility_evaluation m

  else

   begin

    let rr = float r in

     let alpha = special_exponent rr in

      let b = int_of_float ( floor ( rr ** alpha ) ) in

       let mm = matrix_float_cut b m in

        foa_invertibility_evaluation mm.(0)

   end ;;






(** 
generic_float_abs_det matrix
 For big ordres, the matrix must be invertible by blocks. 
This is achieved for some matrices obtained from the random float generator of Ocaml.



Pour de grands ordres, la matrice doit être bloc-inversible.
C'est vérifié pour certaines matrices construites à partir du générateur aléatoire de réels d'Ocaml. *)


let generic_float_abs_det = function m ->

 let r = Array.length m in

  if r < critical_order then abs_float ( float_det m )

  else

   begin

    let rr = float r in

     let alpha = special_exponent rr in

      let b = int_of_float ( floor ( rr ** alpha ) ) in

       let mm = matrix_float_cut b m in

        foa_abs_det mm.(0)

   end ;;






(** 
sym_float_bal_random order range
 *)


let sym_float_bal_random = fun (r:int) (x:float) ->

 let m = upper_trig_float_bal_random r r x in

  float_sym m ;;




(** 
sym_biased_float_random order range
 *)


let sym_biased_float_random = fun (r:int) (x:float) ->

 let m = upper_trig_float_random r r x in

  float_sym m ;;




(** 
sym_signed_float_random order range
 *)


let sym_signed_float_random = fun (r:int) (x:float) ->

 let m = sym_biased_float_random r x

 and w = matrix_float_random r r x in

  matrix_float_twisted_prod ( matrix_float_twisted_prod w m ) w ;;




(** 
sym_positive_float_random order rank range
 *)


let sym_positive_float_random = fun (r:int) (rank:int) (x:float) ->

 let j = rank_float_matrix r r rank

 and p = matrix_float_random r r x in

  matrix_float_twisted_prod p ( matrix_float_twisted_prod p j ) ;;




(** 
sym_positive_float_bal_random order rank range
 *)


let sym_positive_float_bal_random = fun (r:int) (rank:int) (x:float) ->

 let j = rank_float_matrix r r rank

 and p = matrix_float_bal_random r r x in

  matrix_float_twisted_prod p ( matrix_float_twisted_prod p j ) ;;




(** 
antisym_biased_float_random order range
 *)


let antisym_biased_float_random = fun (r:int) (x:float) ->

 let m = upper_nil_float_random r r x in

  float_antisym m ;;




(** 
antisym_float_bal_random order range
 *)


let antisym_float_bal_random = fun (r:int) (x:float) ->

 let m = upper_nil_float_bal_random r r x in

  float_antisym m ;;






(** 
special_float_pseudo_random order approx_quadratic_range
 The result is in SL(n,R),
the lower right coefficient is always 1..



Le résultat est dans SL(n,R), le coefficient en bas à droite est toujours 1.. *)


let special_float_pseudo_random = fun (r:int) (x:float) ->

 let a = upper_unip_float_bal_random r r x

 and b = upper_unip_float_bal_random r r x in

  matrix_float_twisted_prod a b ;;






(** 
special_float_random order approx_quartic_range
 The result is in SL(n,R).



Le résultat est dans SL(n,R). *)


let special_float_random = fun (r:int) (x:float) ->

 let rr = pred r in

  let a = special_float_pseudo_random r x

  and s = vector_float_sign_random rr

  and d = vector_float_random rr 2.

  and b = special_float_pseudo_random r x in

   let i = Random.int rr

   and ddd = vector_float_coeff_prod s d in

    let dd = Array.append ( Array.append ( Array.sub ddd 0 i ) [| 1. /. ( vector_float_contraction ddd ) |] ) ( Array.sub ddd i ( rr - i ) ) in

     matrix_float_twisted_prod a ( float_diag_left_mult dd b ) ;;








(** 
sym_int_bal_random order range
 *)


let sym_int_bal_random = fun (r:int) (x:int) ->

 let m = upper_trig_int_bal_random r r x in

  int_sym m ;;




(** 
sym_biased_int_random order range
 *)


let sym_biased_int_random = fun (r:int) (x:int) ->

 let m = upper_trig_int_random r r x in

  int_sym m ;;




(** 
sym_signed_int_random order range
 *)


let sym_signed_int_random = fun (r:int) (x:int) ->

 let m = sym_biased_int_random r x

 and w = matrix_int_random r r x in

  matrix_int_twisted_prod ( matrix_int_twisted_prod w m ) w ;;




(** 
sym_positive_int_random order rank range
 *)


let sym_positive_int_random = fun (r:int) (rank:int) (x:int) ->

 let j = rank_int_matrix r r rank

 and p = matrix_int_random r r x in

  matrix_int_twisted_prod p ( matrix_int_twisted_prod p j ) ;;




(** 
sym_positive_int_bal_random order rank range
 *)


let sym_positive_int_bal_random = fun (r:int) (rank:int) (x:int) ->

 let j = rank_int_matrix r r rank

 and p = matrix_int_bal_random r r x in

  matrix_int_twisted_prod p ( matrix_int_twisted_prod p j ) ;;




(** 
antisym_biased_int_random order range
 *)


let antisym_biased_int_random = fun (r:int) (x:int) ->

 let m = upper_nil_int_random r r x in

  int_antisym m ;;




(** 
antisym_int_bal_random order range
 *)


let antisym_int_bal_random = fun (r:int) (x:int) ->

 let m = upper_nil_int_bal_random r r x in

  int_antisym m ;;






(** 
special_int_pseudo_random order approx_quadratic_range
 The result is in SL(n,Z),
the lower right coefficient is always 1.



Le résultat est dans SL(n,Z), le coefficient en bas à droite est toujours 1. *)


let special_int_pseudo_random = fun (r:int) (x:int) ->

 let a = upper_unip_int_bal_random r r 2

 and b = upper_unip_int_bal_random r r x in

  matrix_int_twisted_prod a b ;;






(** 
special_int_random order approx_quartic_range
 The result is in SL(n,Z).



Le résultat est dans SL(n,Z). *)


let special_int_random = fun (r:int) (x:int) ->

 let a = special_int_pseudo_random r x

 and d = vector_int_sign_random ( pred r )

 and b = special_int_pseudo_random r x in

  let dd = Array.append d [| vector_int_contraction d |] in

   matrix_int_twisted_prod a ( int_diag_left_mult dd b ) ;;






(** 
invertible_int_random order approx_quartic_range
 The result is in GL(n,Z).



Le résultat est dans GL(n,Z).*)


let invertible_int_random = fun (r:int) (x:int) ->

 let a = special_int_pseudo_random r x

 and d = vector_int_sign_random r

 and b = special_int_pseudo_random r x in

  matrix_int_twisted_prod a ( int_diag_left_mult d b ) ;;






(** 
gen_sympl_float half_dimension
 *)


let gen_sympl_float = function (n:int) ->

 let z = Float_matrix_cons ( null_float n n )

 and u = Float_matrix_cons ( identity_float n n )

 and uu = Float_matrix_cons ( scal_float n n (-1.) ) in

 matrix_float_demakeup ( matrix_foa_paste ( Foa_matrix_cons [| [| z ; uu |] ; [| u ; z |] |] ) ) ;;






(** 
gen_sympl_int half-dimension
 *)


let gen_sympl_int = function (n:int) ->

 let z = Int_matrix_cons ( null_int n n )

 and u = Int_matrix_cons ( identity_int n n )

 and uu = Int_matrix_cons ( scal_int n n (-1) ) in

 matrix_int_demakeup ( matrix_ioa_paste ( Ioa_matrix_cons [| [| z ; uu |] ; [| u ; z |] |] ) ) ;;






(** 
float_companion vector
 The vector contains the coefficients of a unitary polynomial 
(except the principal).



Le vecteur contient les coefficients d'un polynome unitaire (sauf le principal). *)


let float_companion = function (v:float array) ->

 let r = Array.length v in

  let rr = r - 1

  and m = matrix_float_nil r in

   let row = m.(rr) in

    for j = 0 to rr - 1 do

     row.(j) <- -. v.(j)

    done ;

    float_transpose m ;;






(** 
int_companion vector
 *)


let int_companion = function (v:int array) ->

 let r = Array.length v in

  let rr = r - 1

  and m = matrix_int_nil r in

   let row = m.(rr) in

    for j = 0 to rr do

     row.(j) <- - v.(j)

    done ;

    int_transpose m ;;






(** 
ortho_float_antisym matrix
 The input matrix is supposed to be antisymmetric.



La matrice entrante est supposée antisymétrique. *)


let ortho_float_antisym = function (a:float array array) ->

 let i = eye_float a in

  let b = matrix_float_plus i a in

   let c = float_approx_inv matrix_float_norm_inf float_inv b in

    matrix_float_minus ( matrix_float_scal_mult 2. c.(0) ) i ;;




(** 
generic_ortho_float_antisym matrix
 The input matrix is supposed to be antisymmetric.



La matrice entrante est supposée antisymétrique. *)


let generic_ortho_float_antisym = function (a:float array array) ->

 let i = eye_float a in

  let b = matrix_float_plus i a in

   let c = float_approx_inv matrix_float_norm_inf generic_float_inv b in

    matrix_float_minus ( matrix_float_scal_mult 2. c.(0) ) i ;;




(** 
ortho_biased_float_random order range
 *)


let ortho_biased_float_random = fun (r:int) (x:float) ->

 let a = antisym_biased_float_random r x in

  generic_ortho_float_antisym a ;;




(** 
ortho_float_bal_random order range
 *)


let ortho_float_bal_random = fun (r:int) (x:float) ->

 let a = antisym_float_bal_random r x in

  generic_ortho_float_antisym a ;;




(** 
sympl_float_sym matrix
 The input matrix is supposed to be symmetric.



La matrice entrante est supposée symétrique. *)


let sympl_float_sym = function (a:float array array) ->

 let i = eye_float a

 and l = Array.length a in

  let j = gen_sympl_float ( l / 2 ) in

   let b = matrix_float_prod a j in

    let c = matrix_float_plus i b in

     let d = float_approx_inv matrix_float_norm_inf float_inv c in

      matrix_float_minus ( matrix_float_scal_mult 2. d.(0) ) i ;;




(** 
sympl_biased_float_random half-order range
 *)


let sympl_biased_float_random = fun (r:int) (x:float) ->

 let a = sym_biased_float_random ( 2 * r ) x in

  let i = eye_float a

  and l = Array.length a in

   let j = gen_sympl_float ( l / 2 ) in

    let b = matrix_float_prod a j in

     let c = matrix_float_plus i b in

      let d = float_approx_inv matrix_float_norm_inf generic_float_inv c in

       matrix_float_minus ( matrix_float_scal_mult 2. d.(0) ) i ;;




(** 
sympl_float_bal_random half-order range
 *)


let sympl_float_bal_random = fun (r:int) (x:float) ->

 let a = sym_float_bal_random ( 2 * r ) x in

  let i = eye_float a

  and l = Array.length a in

   let j = gen_sympl_float ( l / 2 ) in

    let b = matrix_float_prod a j in

     let c = matrix_float_plus i b in

      let d = float_approx_inv matrix_float_norm_inf generic_float_inv c in

       matrix_float_minus ( matrix_float_scal_mult 2. d.(0) ) i ;;






(** 
givens_matrix order first_index second_index angle
 *)


let givens_matrix = fun (r:int) (i:int) (j:int) (t:float) ->

 let w = identity_float r r in

  if i < j && j < r then

   begin

    let row = w.(i)

    and ligne = w.(j)

    and c = cos t

    and s = sin t in 

     row.(i) <- c ;

     row.(j) <- -. s ;

     ligne.(i) <- s ;

     ligne.(j) <- c ;

   end ;

  if j < i && i < r then

   begin

    let row = w.(i)

    and ligne = w.(j)

    and c = cos t

    and s = sin t in 

     row.(i) <- c ;

     row.(j) <- s ;

     ligne.(i) <- -. s ;

     ligne.(j) <- c ;

   end ;

   w ;;






(** 
jacobi_step_angle threshold Mii Mjj Mij
 *)


let jacobi_step_angle = fun (threshold:float) (x:float) (y:float) (z:float) ->

 if abs_float ( x -. y ) < threshold then atan 1.

 else 0.5 *. ( atan2 ( y -. x ) ( 2. *. z ) ) ;;






(** 
sym_float_classical_jacobi_step threshold matrix
 Output : the transformed matrix of the matrix m, 
the left factor of the previous triple product, the right factor of the triple product.



Input : threshold for jacobi_step_angle, symmetric matrix.



Entrée : seuil pour jacobi_step_angle, matrice symétrique.



Sortie : la matrice transformée de la matrice m, le facteur de gauche du triple produit précédent, le facteur de droite du triple produit. *)


let sym_float_classical_jacobi_step = fun (threshold:float) (m:float array array) ->

 let mm = matrix_float_abs ( matrix_float_non_diag_part m )

 and w = ref ( matrix_float_copy m )

 and r = Array.length m in

  let mmm = matrix_max mm

  and g = ref ( identity_float r r )

  and gg = ref ( identity_float r r ) in


(** Une recherche polymorphe fonctionne mieux qu'une recherche dans la catégorie float,
probablement à cause de troncatures de mantisses : 
A polymorphic query operates better than a query inside the float category, 
probably because of truncatures of mantissas. *)


   let index = matrix_float_find_first_last mmm mm in

    let i = index.(0)

    and j = index.(1) in

     if i <> j then

      begin

       let ii = min i j

       and jj = max i j in

        let row = m.(ii) in

         let t = jacobi_step_angle threshold row.(ii) m.(jj).(jj) row.(jj) in

          g := givens_matrix r ii jj t ;

          gg := givens_matrix r ii jj ( -. t ) ;

          w := matrix_float_triple_prod !gg m !g

      end ;

      [| !w ; !gg ; !g |] ;;






(** 
sym_float_classical_jacobi_reduc step_threshold elasticity diag_threshold max_steps matrix
 
Input : threshold for jacobi_step_angle, elasticity to rule overshoot, threshold for non-diagonality norm, maximal number of steps, symmetric matrix.



Output : approximate eigenvalues, left orthogonal transformation whose rows 
are the approximate eigenvectors, final iteration close to the diagonal matrix, 
right orthogonal transformation whose columns are the approximate eigenvectors,
measure of non_diagonality.



The elasticity is supposed to be between 0 and 1. The more it gets closer to zero,
the more one allows the error to diagonality to climb up between two steps.



Entrée : seuil pour jacobi_step_angle, élasticité pour réguler l'outrepassement, seuil pour la norme de non-diagonalité, nombre maximal de pas, matrice symétrique.



Sortie : valeurs propres approchées, changement de coordonnées isométrique gauche dont les lignes 
sont les vecteurs propres approchés, itération finale approchant la matrice diagonalisée, 
changement de coordonnées isométrique droit dont les colonnes sont les vecteurs propres approchés, 
écart à la diagonalité.



L'élasticité est censée être comprise entre 0 et 1. Plus on s'approche de zéro, 
plus on tolère une remontée de l'écart à la diagonalité entre deux pas. *)


let sym_float_classical_jacobi_reduc = fun (step_threshold:float) (elasticity:float) (diag_threshold:float) (s:int) (m:float array array) ->

 let measure = ref ( matrix_float_non_diagonality matrix_float_square_frobenius m )

 and old_measure = ref max_float

 and steps = ref 0

 and mm = ref m

 and old_mm = ref m

 and r = Array.length m in

  let i = identity_float r r in

   let left = ref i

   and right = ref i in

    while ( !measure > diag_threshold ) && ( ( !old_measure > elasticity *. !measure ) && ( !steps < s ) ) do

     let resultat = sym_float_classical_jacobi_step step_threshold !mm in

      old_mm := !mm ;

      mm := resultat.(0) ;

      old_measure := !measure ;

      measure := matrix_float_non_diagonality matrix_float_square_frobenius !mm ;

      if elasticity *. !measure < !old_measure then

       begin

        left := matrix_float_prod resultat.(1) !left ;

        right := matrix_float_prod !right resultat.(2) ;

        steps := !steps + 1 ;

       end

      else

       begin

        mm := !old_mm ;

        measure := !old_measure ;

        steps := max_int ;

       end ;

    done ;

    [| [| extract_diag !mm |] ; !left ; !mm ; !right ; [|[| !measure |]|] |] ;;






(** 
sym_float_adapt matrix
 This is taken from the HP15C calulator's high level mathematical functions manual.



WARNING : THE SPECIFICATIONS FOR THIS ALGORITHM ARE UNKNOWN TO US.
CERTAIN SYMMETRIC MATRICES MAY PREVENT THIS ALGORITHM TO START: FOR EXAMPLE [| [| 1. ; 1. |] ; [| 1. ; 1. |] |].



The matrix obtained through orthogonal transformation should be closer to a diagonal matrix.



Output : the transformed matrix of the matrix m, the left factor of the previous triple product, the right factor of the triple product.



La matrice obtenue par changement de coordonnées isométrique est censée se rapprocher d'une matrice diagonale.



AVERTISSEMENT : LES SPÉCIFICATIONS POUR CET ALGORITHME NOUS SONT INCONNUES.
CERTAINES MATRICES SYMÉTRIQUES PEUVENT EMPÊCHER CET ALGORITHME DE DÉMARRER : PAR EXEMPLE [| [| 1. ; 1. |] ; [| 1. ; 1. |] |].



Ceci provient du manuel des fonctions mathématiques de haut niveau de la calculette HP15C. 



Sortie : la matrice transformée de la matrice m, le facteur de gauche du triple produit précédent, le facteur de droite du triple produit.*)


let sym_float_adapt = function (m:float array array) ->

 let r = Array.length m in

  let a = Array.make_matrix r r 0.

  and d = extract_diag m

  and rr = r - 1 in

   for i = 0 to rr do

    let row_input = m.(i)

    and row_output = a.(i) in

     let aa = d.(i) in

      for j = 0 to rr do

       if ( i <> j ) && ( row_input.(j) <> 0. ) then

        begin

         let angle = 2. *. row_input.(j) /. ( aa -. d.(j) ) in

          row_output.(j) <- tan ( (atan angle) /. 4. )

        end

       done ;

      done ;

      let b = float_antisym a in

       let q = ortho_float_antisym b in

        let qq = float_transpose q in

         [| matrix_float_triple_prod qq m q ; qq ; q |] ;;






(** 
sym_float_reduc threshold max_steps matrix
 This is taken from the HP15C calulator's high level mathematical functions manual.



WARNING : THE SPECIFICATIONS FOR THIS ALGORITHM ARE UNKNOWN TO US.
CERTAIN SYMMETRIC MATRICES MAY PREVENT THIS ALGORITHM TO START: FOR EXAMPLE [| [| 1. ; 1. |] ; [| 1. ; 1. |] |].



Input : threshold for non-diagonality norm, maximal number of steps, symmetric matrix.



Output : approximate eigenvalues, left orthogonal transformation whose rows 
are the approximate eigenvectors, final iteration close to the diagonal matrix, 
right orthogonal transformation whose columns are the approximate eigenvectors,
measure of non_diagonality.



A threshold equal to  sqrt ( epsilon_float )  is good for small orders.
A bigger threshold is recommended for big orders.



AVERTISSEMENT : LES SPÉCIFICATIONS POUR CET ALGORITHME NOUS SONT INCONNUES.
CERTAINES MATRICES SYMÉTRIQUES PEUVENT EMPÊCHER CET ALGORITHME DE DÉMARRER : PAR EXEMPLE [| [| 1. ; 1. |] ; [| 1. ; 1. |] |].



Entrée : seuil pour la norme de non-diagonalité, nombre maximal de pas, matrice symétrique.



Sortie : valeurs propres approchées, changement de coordonnées isométrique gauche dont les lignes 
sont les vecteurs propres approchés, itération finale approchant la matrice diagonalisée, 
changement de coordonnées isométrique droit dont les colonnes sont les vecteurs propres approchés, 
écart à la diagonalité.



Un seuil égal à  sqrt ( epsilon_float )  convient aux petits ordres.
Augmenter le seuil pour les grands ordres.



Ceci provient du manuel des fonctions mathématiques de haut niveau de la calculette HP15C. 
Certaines matrices symétriques peuvent mettre cet algorithme en échec :
utiliser sym_float_tune_reduc à la place.
*)


let sym_float_reduc = fun (threshold:float) (s:int) (m:float array array) ->

 let measure = ref max_float

 and steps = ref 0

 and mm = ref m

 and r = Array.length m in

  let i = identity_float r r in

   let left = ref i

   and right = ref i in

    while ( !measure > threshold ) && ( !steps < s ) do

     let resultat = sym_float_adapt !mm in

      mm := resultat.(0) ;

      left := matrix_float_prod resultat.(1) !left ;

      right := matrix_float_prod !right resultat.(2) ;

      measure := matrix_float_non_diagonality matrix_float_norm_inf !mm ;

      steps := !steps + 1 ;

    done ;

    [| [| extract_diag !mm |] ; !left ; !mm ; !right ; [|[| !measure |]|] |] ;;






(** 
sym_float_tune_reduc threshold max_steps matrix
 This may give better results than sym_float_reduc.



WARNING : THE SPECIFICATIONS FOR THIS ALGORITHM ARE UNKNOWN TO US.
WE DO NOT KNOW FOR WHICH SYMMETRIC MATRIX THE ALGORITHM STARTS.



The input and output have the same form as for sym_float_reduc.



Les résultats peuvent être meilleurs qu'avec sym_float_reduc.



AVERTISSEMENT : LES SPÉCIFICATIONS POUR CET ALGORITHME NOUS SONT INCONNUES.
NOUS NE SAVONS PAS POUR QUELLES MATRICES SYMÉTRIQUES CET ALGORITHME DÉMARRE.



Les entrée et sortie ont la même forme que pour sym_float_reduc. *)


let sym_float_tune_reduc = fun (threshold:float) (s:int) (m:float array array) ->

 let g = ortho_float_bal_random (Array.length m) 0.1 in

  let gg = float_transpose g in

   let mm = matrix_float_prod gg ( matrix_float_prod m g ) in

    let result = sym_float_reduc threshold s mm in

     let q = matrix_float_prod g result.(3)

     and qq = matrix_float_prod result.(1) gg in

      [| result.(0) ; qq ; result.(2) ; q ; result.(4) |] ;;




(** 
sym_float_sort_reduc methode matrix
 The eigenvalues are sorted in increasing order.



The reduction method methode must be stated with all its parameters.



Output : approximate eigenvalues, left orthogonal transformation whose rows 
are the approximate eigenvectors, final iteration close to the diagonal matrix, 
right orthogonal transformation whose columns are the approximate eigenvectors,
measure of non_diagonality.



Les valeurs propres sont triées dans l'ordre croissant.



La méthode de réduction methode doit être précisée avec tous ses paramètres.



Sortie : valeurs propres approchées, changement de coordonnées isométrique gauche dont les lignes 
sont les vecteurs propres approchés, itération finale approchant la matrice diagonalisée, 
changement de coordonnées isométrique droit dont les colonnes sont les vecteurs propres approchés, 
écart à la diagonalité. *)


let sym_float_sort_reduc = fun methode (m:float array array) ->

 let r = methode m

 and l = Array.length m in

  let d = r.(0).(0)

  and left = ref r.(1)

  and right = ref r.(3)

  and index = Array.make l 0 in

   let dd = vector_float_copy d in

    Array.fast_sort compare dd ;

    for i = 0 to l - 1 do

     let j = vector_float_find_first dd.(i) d in

      d.(j) <- max_float ;

      index.(i) <- j ;

      right := exchange_column i j !right ;

      left := exchange_row i j !left ;

    done ;

    let result = matrix_float_triple_prod !left m !right in 

     let measure = matrix_float_non_diagonality matrix_float_norm_inf result in

      [| [| dd |] ; !left ; result ; !right ; [|[| measure |]|] |] ;;






(** 
float_trans_orthonormalize matrix
 The rows of the matrix form the basis of the subspace in question.



Les lignes de la matrices forment la base du sous-espace considéré. *)


let float_trans_orthonormalize = fun (m:float array array) ->

 let r = Array.length m

 and init = m.(0) in

  let c = Array.length init

  and accu = matrix_float_copy m

  and rr = r - 1 in

   let result = Array.make_matrix r c 0. in

    result.(0) <- vector_float_scal_left_div ( vector_float_norm_2 init ) init ;

    for i = 1 to rr do

     let row = ref accu.(i) in

      for ii = 0 to i - 1 do

       let x = ( vector_float_scal_prod !row result.(ii) ) in

        row := vector_float_minus !row ( vector_float_scal_mult x result.(ii) )

      done ;

      result.(i) <- vector_float_scal_left_div ( vector_float_norm_2 !row) !row

    done ;

    result ;;






(** 
float_orthonormalize matrix
 The columns of the matrix form the basis of the subspace in question.



Les colonnes de la matrices forment la base du sous-espace considéré. *)


let float_orthonormalize = fun (m:float array array) ->

 let mm = float_transpose m in

  float_transpose ( float_trans_orthonormalize mm ) ;;






(** 
sym_float_indirect_reduc factor methode_reduc matrix
 
Output : approximate eigenvalues, left orthogonal transformation whose rows 
are the approximate eigenvectors, final iteration close to the diagonal matrix, 
right orthogonal transformation whose columns are the approximate eigenvectors,
measure of non_diagonality.



Sortie : valeurs propres approchées, changement de coordonnées isométrique gauche dont les lignes 
sont les vecteurs propres approchés, itération finale approchant la matrice diagonalisée, 
changement de coordonnées isométrique droit dont les colonnes sont les vecteurs propres approchés, 
écart à la diagonalité. *)


let sym_float_indirect_reduc = fun methode_reduc (m:float array array) ->

 let res = methode_reduc m in

  let p = res.(3) in

   let q = float_trans_orthonormalize p in

    let pp = float_transpose q in

     let d = matrix_float_triple_prod pp m q in

      let result = methode_reduc d in

       [| result.(0) ; matrix_float_prod pp result.(1) ; result.(2) ; matrix_float_prod result.(3) q ; result.(4) |] ;;






(** 
float_pca methode_reduc matrix
 The columns of the input matrix are the coordinates of the sample points.
The reduction methode methode_reduc applies to symmetric matrices ; it must contain all the parameters.
Output : a two_rows matrix containing the isobarycentre and the eigenvalues, the left factor in the diagonalization, 
the right factor in the diagonalization, the measure of non diagonality.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres.
Les colonnes de la matrice entrante forment les coordonnées des points-échantillons.
Sortie : une matrice à deux lignes contenant l'isobarycentre et les valeurs propres, le facteur de gauche de la diagonalisation,
le facteur de droite de la diagonalisation, la mesure de non-diagonalité. *)


let float_pca = fun methode_reduc (x:float array array) ->

 let cc = float ( Array.length x.(0) ) in

  let xbar = matrix_float_mean_by_row x in

   let xxx = Array.mapi ( function i -> vector_float_scal_left_sub xbar.(i) ) x in

    let xx = matrix_float_scal_left_div ( sqrt cc ) xxx in

     let z = matrix_float_twisted_prod xx xx in

      let zz = methode_reduc z in

       [| [| xbar ; zz.(0).(0) |] ; zz.(1) ; zz.(2) ; zz.(3) ; zz.(4) |] ;;






(** 
float_iterate steps matrix vector
 *)


let float_iterate = fun (s:int) (x:float array array) (v:float array) ->

 let y = ref v in

  if s >= 0 then

   begin

    for i = 1 to s do

     y := matrix_vector_float_prod x !y

    done

   end

  else

   begin

    let xx =  ( float_approx_inv matrix_float_norm_inf float_inv x ).(0) in

     for i = 1 to abs s do

      y := matrix_vector_float_prod xx !y

     done

   end ;

   !y ;;






(** 
float_normalized_iterate norm steps matrix vector
 *)


let float_normalized_iterate = fun norm (s:int) (x:float array array) (v:float array) ->

 if s < 0 then failwith "Negative power forbidden in Matrix.float_normalized_iterate." ;

 let y = ref ( vector_float_scal_left_div ( norm v ) v )

 and i = ref 1 in

  let z = ref !y in

   while !i <= s do

    z := matrix_vector_float_prod x !y ;

    z := vector_float_scal_left_div ( norm !z ) !z ;

    if norm ( vector_float_minus !z !y ) == 0. then i := max_int

    else ( i := !i + 1 ; y := !z ) ;

   done ;

   !z ;;






(** 
float_power steps matrix
 *)


let rec float_power = fun (s:int) (x:float array array) ->

 if s >= 0 then

  begin

   if s == 0 then eye_float x

   else

    let n = s / 2 in

     let factor = float_power n x in

      let prod = matrix_float_prod factor factor in

       if s mod 2 == 0 then prod

       else matrix_float_prod prod x

  end

 else

  begin

   let xx = ( float_approx_inv matrix_float_norm_inf float_inv x ).(0) in

    float_power ( abs s ) xx

  end ;;






(** 
float_nilpotence_order norm threshold matrix
 *)


let float_nilpotence_order = fun norm (threshold:float) (x:float array array) ->

 let s = ref 1. in

  if norm x >= threshold then

   begin

    let r = Array.length x

    and factor = ref x

    and exponent = ref 1 in

     while !exponent < r do

      begin

       let prod = matrix_float_prod !factor x in

        if norm prod < threshold then ( s := 1. +. ( float !exponent ) ; exponent := max_int )

        else ( factor := prod ; s := infinity ; exponent := succ !exponent ) ;

      end

     done ;

   end ;

  !s ;;






(** 
generic_float_iterate steps matrix vector
 *)


let generic_float_iterate = fun (s:int) (x:float array array) (v:float array) ->

 let y = ref v in

  if s >= 0 then

   begin

    for i = 1 to s do

     y := matrix_vector_float_prod x !y

    done

   end

  else

   begin

    let xx =  ( float_approx_inv matrix_float_norm_inf generic_float_inv x ).(0) in

     for i = 1 to abs s do

      y := matrix_vector_float_prod xx !y

     done

   end ;

   !y ;;






(** 
generic_float_power steps matrix
 *)


let rec generic_float_power = fun (s:int) (x:float array array) ->

 if s >= 0 then

  begin

   if s == 0 then eye_float x

   else

    let n = s / 2 in

     let factor = float_power n x in

      let prod = matrix_float_prod factor factor in

       if s mod 2 == 0 then prod

       else matrix_float_prod prod x

  end

 else

  begin

   let xx = ( float_approx_inv matrix_float_norm_inf generic_float_inv x ).(0) in

    float_power ( abs s ) xx

  end ;;






(** 
int_iterate steps matrix vector
 *)


let int_iterate = fun (s:int) (x:int array array) (v:int array) ->

 let y = ref v in

  if s >= 0 then

   begin

    for i = 1 to s do

     y := matrix_vector_int_prod x !y

    done

   end

  else

   begin

    let xx = int_inv x in

     for i = 1 to abs s do

      y := matrix_vector_int_prod xx !y

     done

   end ;

   !y ;;






(** 
int_normalized_iterate norm steps matrix vector
 *)


let int_normalized_iterate = fun norm (s:int) (x:int array array) (v:int array) ->

 if s < 0 then failwith "Negative power forbidden in Matrix.int_normalized_iterate." ;

 let y = ref ( vector_int_scal_left_div ( norm v ) v )

 and i = ref 1 in

  let z = ref !y in

   while !i <= s do

    z := matrix_vector_int_prod x !y ;

    z := vector_int_scal_left_div ( norm !z ) !z ;

    if norm ( vector_int_minus !z !y ) == 0 then i := max_int

    else ( i := !i + 1 ; y := !z ) ;

   done ;

   !z ;;






(** 
int_power steps matrix
 *)


let rec int_power = fun (s:int) (x:int array array) ->

 if s >= 0 then

  begin

   if s == 0 then eye_int x

   else

    let n = s / 2 in

     let factor = int_power n x in

      let prod = matrix_int_prod factor factor in

       if s mod 2 == 0 then prod

       else matrix_int_prod prod x

  end

 else

  begin

   let xx = int_inv x in

    int_power ( abs s ) xx

  end ;;






(** 
int_nilpotence_order threshold matrix
 *)


let int_nilpotence_order = function (x:int array array) ->

 let s = ref 1. in

  if matrix_int_norm_inf x <> 0 then

   begin

    let r = Array.length x

    and factor = ref x

    and exponent = ref 1 in

     while !exponent < r do

      begin

       let prod = matrix_int_prod !factor x in

        if matrix_int_norm_inf prod == 0 then ( s := 1. +. ( float !exponent ) ; exponent := max_int )

        else ( factor := prod ; s := infinity ; exponent := succ !exponent ) ;

      end

     done ;

   end ;

  !s ;;






(** 
float_principal steps matrix vector
 *)


let float_principal = fun (s:int) (x:float array array) (v:float array) ->

 let n = ref ( vector_float_norm_inf v )

 and accu = ref 0. in

  let y = ref ( vector_float_scal_left_div !n v ) in

   if s > 0 then

    begin

     for i = 1 to s do

      y := matrix_vector_float_prod x !y ;

      n := vector_float_norm_inf !y ;

      accu := !accu +. log !n ;

      y := vector_float_scal_left_div !n !y

     done ;

     accu := !accu /. ( float s )

    end

   else

    begin

     let xx =  ( float_approx_inv matrix_float_norm_inf float_inv x ).(0) in

      for i = 1 to abs s do

       y := matrix_vector_float_prod xx !y ;

       n := vector_float_norm_inf !y ;

       accu := !accu +. log !n ;

       y := vector_float_scal_left_div !n !y

      done ;

     accu := !accu /. ( abs_float ( float s ) )

    end ;

    [| [| !accu |] ; !y |] ;;






(** 
generic_float_principal steps matrix vector
 *)


let generic_float_principal = fun (s:int) (x:float array array) (v:float array) ->

 let n = ref ( vector_float_norm_inf v )

 and accu = ref 0. in

  let y = ref ( vector_float_scal_left_div !n v ) in

   if s > 0 then

    begin

     for i = 1 to s do

      y := matrix_vector_float_prod x !y ;

      n := vector_float_norm_inf !y ;

      accu := !accu +. log !n ;

      y := vector_float_scal_left_div !n !y

     done ;

     accu := !accu /. ( float s )

    end

   else

    begin

     let xx =  ( float_approx_inv matrix_float_norm_inf generic_float_inv x ).(0) in

      for i = 1 to abs s do

       y := matrix_vector_float_prod xx !y ;

       n := vector_float_norm_inf !y ;

       accu := !accu +. log !n ;

       y := vector_float_scal_left_div !n !y

      done ;

     accu := !accu /. ( abs_float ( float s ) )

    end ;

    [| [| !accu |] ; !y |] ;;






(** 
float_Gram matrix
 The vectors in question are the rows of the matrix.



Les vecteurs à étudier forment les lignes de la matrice. *)


let float_Gram = function (x:float array array) ->

 matrix_float_twisted_prod x x ;;






(** 
int_Gram matrix
 The vectors in question are the rows of the matrix.



Les vecteurs à étudier forment les lignes de la matrice. *)


let int_Gram = function (x:int array array) ->

 matrix_int_twisted_prod x x ;;






(** 
float_rank matrix
 *)


let rec float_rank = function (m:float array array) ->

 let r = ref ( Array.length m )

 and c = ref ( Array.length m.(0) )

 and m_m = ref m in

  if !c < !r then

   begin

    m_m := float_transpose m ; 

    c := !r ;

    r := Array.length !m_m ;

   end ;

   match !r with

   | 0 -> 0

   | 1 -> if vector_float_norm_inf !m_m.(0) = 0. then 0 else 1

   | 2 ->

    begin

     let v = !m_m.(0) in

      let vv = vector_float_abs v in

       let x = vector_float_max vv in

        if x = 0. then float_rank [| !m_m.(1) |]

        else

         begin

          let i = vector_float_find_twin x vv in

           let w = !m_m.(1) in

            let ww = vector_float_minus w ( vector_float_scal_mult ( w.(i) /. v.(i) ) v ) in

             1 + float_rank [| ww |]

         end

    end

   | _ ->

    begin

     let v = !m_m.(0) in

      let vv = vector_float_abs v in

       let x = vector_float_max vv in

        if x = 0. then float_rank ( float_sub_matrix !m_m 1 (!r - 1) 0 (!c - 1) )

        else

         begin

          let i = vector_float_find_twin x vv in

           let w = float_sub_matrix !m_m 1 (!r - 1) 0 (!c - 1) in

            for j = 0 to !r - 2 do

             w.(j) <- vector_float_minus w.(j) ( vector_float_scal_mult ( w.(j).(i) /. v.(i) ) v )

            done ;

            1 + float_rank w

         end

    end ;;






(** 
float_im matrix
 *)


let float_im = function (m:float array array) ->

 let rank = float_rank m

 and r = Array.length m

 and c = Array.length m.(0)

 and i = ref 0 in

  let rr = r - 1

  and w = Array.make_matrix rank r 0. in

   while !i < rank do

    w.(!i) <- matrix_vector_float_prod m ( vector_float_random c 1. ) ;

    let ww = float_sub_matrix w 0 !i 0 rr in

     if float_rank ww = !i + 1 then i := !i + 1

   done ;

   w ;;






(** 
float_ker methode_reduc threshold matrix
 The rows of the output form a basis of the kernel of the matrix.
The reduction methode methode_reduc applies to symmetric matrices ; it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres.
Les lignes de la sortie forment une base du noyau de la matrice. *)


let float_ker = fun methode_reduc (threshold:float) (m:float array array) ->

 let mm = float_transpose m

 and c = Array.length m.(0) in

  let s = matrix_float_twisted_prod mm mm

  and result = ref [] in

   let p = methode_reduc s in

    let diag = p.(0).(0)

    and base = p.(1) in

     for i = 0 to c - 1 do

      if abs_float diag.(i) <= threshold then

       begin

        result :=  base.(i) :: !result 

       end

     done ;

     Array.of_list !result ;;






(** 
int_rank matrix
 *)


let int_rank = function (m:int array array) ->

 let mm = float_of_matrix m in

  float_rank mm ;;






(** 
int_im matrix
 *)


let int_im = function (m:int array array) ->

 let rank = int_rank m

 and r = Array.length m

 and c = Array.length m.(0)

 and i = ref 0

 and accu = ref 1 in

  let rr = r - 1

  and w = Array.make_matrix rank r 0 in

   while !i < rank do

    w.(!i) <- matrix_vector_int_prod m ( vector_int_bal_random c !accu ) ;

    let ww = int_sub_matrix w 0 !i 0 rr in

     if int_rank ww = !i + 1 then ( i := !i + 1 ; accu := 1 ) else accu := 1 + !accu

   done ;

   w ;;






(** 
hyper_proj
 *)


let hyper_proj = fun v w ->

 vector_float_minus w ( vector_float_scal_mult ( ( vector_float_scal_prod v w ) /. ( vector_float_norm_2 v ) ) v )






(** 
float_ortho_proj matrix vector
 The columns of the matrix are required to be a basis of the subspace of the orthogonal projection.



Les colonnes de la matrice sont censées former une base du sous-espace de projection orthogonale. *)


let float_ortho_proj = fun (m:float array array) (v:float array) ->

 let r = Array.length m

 and c = Array.length m.(0)

 and mm = float_transpose m in

  let accu = Array.make r 0.

  and rr = r - 1

  and cc = c - 1 in

   for j = 0 to cc do

    let column = mm.(j) in

     let x = ( ( vector_float_scal_prod v column ) /. vector_float_square_norm_2 column ) in

      for i = 0 to rr do

       accu.(i) <- accu.(i) +. column.(i) *. x

      done

   done ;

   accu ;;






(** 
float_trans_ortho_proj matrix vector
 The rows of the matrix are required to be a basis of the subspace of the orthogonal projection.



Les lignes de la matrice sont censées former une base du sous-espace de projection orthogonale. *)


let float_trans_ortho_proj = fun (m:float array array) (v:float array) ->

 let r = Array.length m

 and c = Array.length m.(0) in

  let accu = Array.make c 0.

  and rr = r - 1

  and cc = c - 1 in

   for i = 0 to rr do

    let row = m.(i) in

     let x = ( ( vector_float_scal_prod v row ) /. vector_float_square_norm_2 row ) in

      for j = 0 to cc do

       accu.(j) <- accu.(j) +. row.(j) *. x

      done

   done ;

   accu ;;






(** 
float_ortho_sym matrix vector
 The columns of the matrix are the generators of the subspace of the orthogonal symmetry.



Les colonnes de la matrices forment les générateurs du sous-espace de symétrie orthogonale. *)


let float_ortho_sym = fun (m:float array array) (v:float array) ->

 vector_float_minus ( vector_float_scal_mult 2. ( float_ortho_proj m v ) ) v ;;






(** 
float_trans_ortho_sym matrix vector
 The rows of the matrix are the generators of the subspace of the orthogonal symmetry.



Les lignes de la matrices forment les générateurs du sous-espace de symétrie orthogonale. *)


let float_trans_ortho_sym = fun (m:float array array) (v:float array) ->

 vector_float_minus ( vector_float_scal_mult 2. ( float_trans_ortho_proj m v ) ) v ;;






(** 
vector_float_chose_3 vector
 The aim is to complete the image of a vector by a homothety into an orthonormal basis
whose second vector is included in the horizontal plane. The vectors of the basis rae output by row.



Il s'agit de compléter l'homothétique unitaire d'un vecteur quelconque de R^3 en une base orthonormée dont le deuxième vecteur est dans le plan horizontal.
Les vecteurs de la base sortent par ligne. *)


let vector_float_chose_3 = fun (u:float array) ->

 let a = u.(0)

 and b = u.(1)

 and c = u.(2) in

  let d = a *. a +. b *. b in

   if d <> 0. then 

    let e = c *. c +. d in

     let eee = sqrt e in

      let ee = 1. /. eee in

       let uu = vector_float_scal_mult ee u

       and dd = 1. /. ( sqrt d ) in

        let v = [| -. b *. dd ; a *. dd ; 0. |] in

         if c > 0. then [| uu ; v ; Util.vector_float_prod_3 uu v |]

         else  [| uu ; v ; Util.vector_float_prod_3 v uu |]

   else 

    if c > 0. then 

     [| [| 0. ; 0. ; 1. |] ; [| 1. ; 0. ; 0. |] ; [| 0. ; 1. ; 0. |] |]

    else 

     [| [| 0. ; 0. ; -1. |] ; [| 1. ; 0. ; 0. |] ; [| 0. ; 1. ; 0. |] |] ;;








(** 
sym_float_pinv methode_reduc threshold matrix
 This comes from the scilab source code, 
restricted to the case when the matrix is symmetric.



Ceci provient du code source de scilab, restreint au cas où la matrice est symétrique. *)


let sym_float_pinv = fun methode_reduc (threshold:float) (m:float array array) ->

 let c = Array.length m.(0)

 and p = methode_reduc m in

  let diag = p.(0).(0)

  and base = p.(1)

  and tbase = p.(3) in

   for i = 0 to c - 1 do

    if abs_float diag.(i) > threshold then

     diag.(i) <- 1. /. diag.(i)

    else diag.(i) <- 0.

   done ;

   matrix_float_prod tbase ( float_diag_left_mult diag base ) ;;






(** 
sym_float_apply methode_reduc function matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_apply = fun methode_reduc (f:float -> float) (m:float array array) ->

 let c = Array.length m.(0)

 and p = methode_reduc m in

  let diag = p.(0).(0)

  and base = p.(1)

  and tbase = p.(3) in

   for i = 0 to c - 1 do

    diag.(i) <- f diag.(i)

   done ;

   matrix_float_prod tbase ( float_diag_left_mult diag base ) ;;






(** 
sym_float_sqrt methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_sqrt = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc sqrt m ;;






(** 
sym_float_log methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_log = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc log m ;;






(** 
sym_float_log10 methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_log10 = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc log10 m ;;






(** 
sym_float_cos methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_cos = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc cos m ;;






(** 
sym_float_sin methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_sin = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc sin m ;;






(** 
sym_float_tan methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_tan = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc tan m ;;






(** 
sym_float_acos methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_acos = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc acos m ;;






(** 
sym_float_asin methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_asin = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc asin m ;;






(** 
sym_float_atan methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_atan = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc atan m ;;






(** 
sym_float_cosh methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_cosh = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc cosh m ;;






(** 
sym_float_sinh methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_sinh = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc sinh m ;;






(** 
sym_float_tanh methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_tanh = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc tanh m ;;






(** 
sym_float_abs_float methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_abs_float = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc abs_float m ;;






(** 
sym_float_frac methode_reduc matrix
 The reduction methode methode_reduc applies to symmetric matrices ; 
it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres. *)


let sym_float_frac = fun methode_reduc (m:float array array) ->

 sym_float_apply methode_reduc Util.frac m ;;






(** 
clean_inv matrix
 *)


let clean_inv = function m ->

( float_tune_inv matrix_float_norm_inf m ( float_slow_inv m ) ).(0) ;;






(** 
slow_clean_inv matrix
 *)


let slow_clean_inv = function m ->

( slow_float_tune_inv matrix_float_norm_inf m ( float_slow_inv m ) ).(0) ;;




(** 
matrix_float_singular_random rows columns rank range
 *)


let matrix_float_singular_random = fun (r:int) (c:int) (rank:int) (x:float) ->

 let j = rank_float_matrix r c rank

 and p = matrix_float_random r c x

 and q = matrix_float_random r c x in

  matrix_float_triple_prod p j q ;;




(** 
matrix_float_singular_bal_random rows columns rank range
 *)


let matrix_float_singular_bal_random = fun (r:int) (c:int) (rank:int) (x:float) ->

 let j = rank_float_matrix r c rank

 and p = matrix_float_bal_random r c x

 and q = matrix_float_bal_random r c x in

  matrix_float_triple_prod p j q ;;










(** 
§ 
 *)



(**

Expérimentations diverses
---
Miscellanous experimentations
 

*)



(** 
 
 *)













(** 
right_float_pinv methode_reduc matrix
 This functions, but it is slow.
The reduction methode methode_reduc applies to symmetric matrices ; it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres.
Cela fonctionne, mais c'est lent. *)


let right_float_pinv = fun methode_reduc (threshold:float) m ->

 let mm = float_transpose m in

  let mmm = matrix_float_twisted_prod mm mm in

   let m_m = sym_float_pinv methode_reduc threshold mmm in

    matrix_float_twisted_prod m_m mm ;;






(** 
left_float_pinv methode_reduc matrix
 This functions, but it is slow.
The reduction methode methode_reduc applies to symmetric matrices ; it must contain all the parameters.



La méthode de réduction methode_reduc s'applique aux matrices symétriques ; elle doit comprendre tous ses paramètres.
Cela fonctionne, mais c'est lent. *)


let left_float_pinv = fun methode_reduc (threshold:float) m ->

 let mm = matrix_float_twisted_prod m m in

   let m_m = sym_float_pinv methode_reduc threshold mm in

    matrix_float_prod (float_transpose m) m_m ;;








(** 
sym_float_reduc_seq threshold max_steps matrix
 Some symmetric matrices may cause this algorithm to fail: use sym_float_tune_reduc instead.



Input : threshold for non-diagonality norm, maximal number of steps, symmetric matrix.



Output : final iteration close to the diagonal matrix, left orthogonal transformation whose rows are the approximate eigenvectors, 
right orthogonal transformation whose columns are the approximate eigenvectors.



Entrée : seuil pour la norme de non-diagonalité, nombre maximal de pas, matrice symétrique.



Sortie : itération finale approchant la matrice diagonalisée, changement de coordonnées isométrique gauche dont les lignes 
sont les vecteurs propres approchés, changement de coordonnées isométrique droit dont les colonnes sont les vecteurs propres approchés.



Certaines matrices symétriques peuvent mettre cet algorithme en échec :
utiliser sym_float_tune_reduc_seq à la place.
*)


let sym_float_reduc_seq = fun (threshold:float) (s:int) (m:float array array) ->

 let measure = ref max_float

 and seq_left = ref [| |]

 and seq_right = ref [| |]

 and seq_candidate = ref [| |]

 and steps = ref 0

 and mm = ref m

 and r = Array.length m in

  let i = identity_float r r in

   let left = ref i

   and right = ref i in

    while ( !measure > threshold ) && ( !steps < s ) do

     let resultat = sym_float_adapt !mm in

      mm := resultat.(0) ;

      seq_candidate := Array.append !seq_candidate [| !mm |] ;

      left := matrix_float_prod resultat.(1) !left ;

      seq_left := Array.append !seq_left [| !left |] ;

      right := matrix_float_prod !right resultat.(2) ;

      seq_right := Array.append !seq_right [| !right |] ;

      measure := matrix_float_non_diagonality matrix_float_norm_inf !mm ;

      steps := !steps + 1 ;

    done ;

    [| !seq_candidate ; !seq_left ; !seq_right |] ;;






(** 
float_normalized_iterate_seq norm steps matrix vector
 *)


let float_normalized_iterate_seq = fun norm (s:int) (x:float array array) (v:float array) ->

 if s < 0 then failwith "Negative power forbidden in Matrix.float_normalized_iterate." ;

 let y = ref ( vector_float_scal_left_div ( norm v ) v )

 and seq = ref [| |]

 and i = ref 1 in

  let z = ref !y in

   while !i <= s do

    z := matrix_vector_float_prod x !y ;

    z := vector_float_scal_left_div ( norm !z ) !z ;

    seq := Array.append !seq [| !z |] ;

    if norm ( vector_float_minus !z !y ) == 0. then i := max_int

    else ( i := !i + 1 ; y := !z ) ;

   done ;

   !seq ;;






(** 
extrap_inv parameter matrix
 *)


let extrap_inv = fun (parameter:float) (x:float array array) ->

 let y0 = float_slow_inv x in

  let y1 = ( float_tune_inv matrix_float_norm_inf x y0 ).(0) in

   matrix_float_plus y1 ( matrix_float_scal_mult parameter ( matrix_float_minus y1 y0 ) ) ;;




(** 
aggressive_inv parameter matrix
 *)


let aggressive_inv = function (x:float array array) ->

 extrap_inv epsilon_float x ;;






(** linear_regression methode_reduc departure arrival *)


let linear_regression = fun methode_reduc (x:float array array) (y:float array array) ->

 let bx = matrix_float_mean_by_row x

 and by = matrix_float_mean_by_row y

 and dim = Array.length x in

  let f = fun v bb -> vector_float_minus v bb

  and d = pred dim in

   let xx = matrix_float_column_apply_vect ( f bx ) x

   and yy = matrix_float_column_apply_vect ( f by ) y

   and dd = d + dim in

    let z = float_pca methode_reduc ( Array.append yy xx ) in

     let r = Array.map sqrt z.(0).(1) in

      let zz = matrix_float_prod z.(3) ( Array.mapi ( fun i v -> vector_float_scal_mult r.(i) v ) z.(1) ) in

       let alpha = float_sub_matrix zz 0 d 0 d

       and beta = float_sub_matrix zz 0 d dim dd

       and gamma = float_sub_matrix zz dim dd 0 d

       and delta = float_sub_matrix zz dim dd dim dd in

        let a0 = matrix_float_prod alpha ( aggressive_inv gamma ) 

        and a1 = matrix_float_prod beta ( aggressive_inv delta ) in

         let a = matrix_float_scal_mult 0.5 ( matrix_float_plus a0 a1 ) in

          let b = vector_float_minus by ( matrix_vector_float_prod a bx ) in

           [| a ; [| b |] |] ;;














(** 
§ § § 
 *)




end ;;















module Fft = struct







open Util ;;

open Data ;;

open Sparse_vector ;;

open Sparse_tensor ;;

open Sparse_matrix ;;

open Mat ;;





module Field (F:Data.Field_coeff_type) = struct










(** 
§ 
 *)



(** 

Introduction

*)



(** 
 
 *)











(**
The mathematician will find in this module:



    

  • constructions of matrices of direct and inverse discrete Fourier transforms
for a primary number of samples (p^n where p is prime),
    • 



    

  • functions of direct and inverse fast Fourier transforms
for a binary number of samples (2^n).
    • 




Comments




The coefficients must belong to a field and the user has to provide the necessary roots of unity.



This module is distributed under the same licence as Ocaml.




§ 




La mathématicienne ou le mathématicien trouvera dans ce module :



    

  • des constructions de matrices de transformées de Fourier discrètes, directes et inverses
pour un nombre d'échantillons primaire (p^n où p est premier),
    • 



    

  • des fonctions de transformées de Fourier rapide directes et inverses
pour un nombre d'échantillons binaire (2^n).
    • 




Commentaires




Les coefficients doivent appartenir à un corps commutatif et l'utilisateur ou l'utilisatrice doit fournir les racines de l'unité nécessaires.



Ce module est distribué selon la même licence qu'Ocaml.




Copyright Stéphane Grognet 


Laboratoire de mathématiques Jean Leray UMR 6629 CNRS 


Fédération de recherche mathématique des Pays de la Loire 


IREM des Pays de la Loire - Université de Nantes 


version 0.1

*)



(**
@version 0.1
*)



(**
@author Stéphane Grognet
*)



(**
@since 2012, 2013
*)











(** 
§ 
 *)



(** 

Constructions minimales


Minimal constructions

*)



(** 
 
 *)










open Util ;;

module M = Mat.Field (F) ;;






(** 
dft primitive_root_of_unity dimension




La racine primitive de l'unité omega est supposée d'ordre n.
Dans le cas des nombres complexes, on prend exp ( - 2 * i * pi / n ). *)


let dft = fun (omega:F.t) (n:int) ->

 let m = Array.make_matrix n n omega

 and nn = pred n in

  for i = 0 to nn do

   let row = m.(i) in

    for j = 0 to nn do

     row.(j) <- F.int_pow ( i * j mod n ) omega ;

    done ;

  done ;

  M.Full_matrix m ;;




(** 
inverse_dft primitive_root_of_unity dimension




La racine primitive de l'unité omega est supposée d'ordre n.
Dans le cas des nombres complexes, on prend exp ( - 2 * i * pi / n ). *)


let inverse_dft = fun (omega:F.t) (n:int) ->

 let m = Array.make_matrix n n omega

 and nn = pred n

 and d = F.int_div n in

  for i = 0 to nn do

   let row = m.(i) in

    for j = 0 to nn do

     row.(j) <- d ( F.int_pow ( - i * j mod n ) omega ) ;

    done ;

  done ;

  M.Full_matrix m ;;




(** 
twist_dft_vector twist_factor dimension
 *)


let twist_dft_vector = fun (twist:F.t) (n:int) ->

 let v = Array.map F.one ( Array.make n () ) in

  for i = 1 to pred n do

   v.(i) <- F.mult twist v.( pred i )

  done ;

  M.Full_vector v ;;




(** 
twist_dft_matrix twist_factor dimension
 *)


let twist_dft_matrix = fun (twist:F.t) (n:int) ->

 M.vector_to_diag ( twist_dft_vector twist n ) ;;




(** 
twisted_dft primitive_root_of_unity dimension twist_factor
 *)


let twisted_dft = fun (omega:F.t) (n:int) (twist:F.t) ->

 let m = dft omega n

 and mm = twist_dft_matrix twist n in

  M.matrix_to_full ( M.matrix_mult m mm ) ;;










(** 
§ 
 *)



(** 

Constructions matricielles


Matrix constructions

*)



(** 
 
 *)











(** 
§ 
 *)



(** 

Algorithme binaire de Gauss-Runge-Danielson-Lanczos-Cooley-Tukey


Binary algorithm of Gauss-Runge-Danielson-Lanczos-Cooley-Tukey

*)



(** 
 
 *)













(**



décrit dans le polycopié Baudoin-Bercher ESIEE 2001.
*)













(** 
scal_block_fft scalar dimension
 *)


let scal_block_fft = fun (x:F.t) (dim:int) ->

 M.scal_matrix x dim ;;




(** 
element_binary_fft primitive_root_of_unity degree exponent
 *)


let element_binary_fft = fun (omega:F.t) (n:int) (exponent:int) ->

 if n < 0 then failwith "Bad degree in Fft.element_binary_fft." ;

 let dim = Util.int_power n 2

 and x = F.int_pow exponent omega in

  let block_1 = scal_block_fft ( F.one () ) dim

  and block_2 = scal_block_fft x dim

  and block_3 = scal_block_fft ( F.opp x ) dim in

   M.matrix_of_blocks [| [| block_1 ; block_2 |] ; [| block_1 ; block_3 |] |] ;;




(** 
factor_binary_fft primitive_root_of_unity degree step
 *)


let factor_binary_fft = fun (omega:F.t) (n:int) (step:int) ->

 if n < 2 then failwith "Bad degree in Fft.element_binary_fft." ;

 let nn = pred n in

  if ( step < 0 ) || ( step > nn ) then failwith "Bad step in Fft.element_binary_fft." ;

  let slicing = Util.int_power step 2

  and complement = nn - step in

   let small_dim = Util.int_power complement 2 in

    let z = M.matrix_sparse_null ( Array.make 2 ( 2 * small_dim ) ) in

     let m = Array.make_matrix slicing slicing z in

      for i = 0 to pred slicing do

       let ii = Util.truncated_bit_reversal nn i in

        m.(i).(i) <- element_binary_fft omega complement ii ;

      done ;

      M.matrix_of_blocks m ;;




(** 
naive_aux_binary_fft primitive_root_of_unity degree
 *)


let naive_aux_binary_fft = fun (omega:F.t) (n:int) ->

 let accu = ref ( factor_binary_fft omega n 0 ) in

  for i = 1 to pred n do

   accu := M.matrix_mult ( factor_binary_fft omega n i ) !accu ;

  done ;

  M.matrix_to_full !accu ;;




(** 
aux_binary_fft_matrix primitive_root_of_unity degree
 *)


let aux_binary_fft_matrix = fun (omega:F.t) (n:int) ->

 let accu = ref ( M.matrix_transpose ( factor_binary_fft omega n 0 ) ) in

  for i = 1 to pred n do

   accu := M.matrix_twisted_mult !accu ( factor_binary_fft omega n i ) ;

  done ;

  M.matrix_to_full ( M.matrix_transpose !accu ) ;;




(** 
binary_row_mix degree matrix
 *)


let binary_row_mix = fun (n:int) (m:M.matrix) ->

 let dim = int_power n 2 in

  for i = 0 to pred dim do

   let ii = truncated_bit_reversal n i in

    if ( ii > i ) then

     M.matrix_row_exchange i ii m

  done ;;




(** 
binary_fft_matrix primitive_root_of_unity degree
 *)


let binary_fft_matrix = fun (omega:F.t) (n:int) ->

 let m = aux_binary_fft_matrix omega n in

  binary_row_mix n m ;

  m ;;




(** 
inverse_binary_fft_matrix primitive_root_of_unity degree
 *)


let inverse_binary_fft_matrix = fun (omega:F.t) (n:int) ->

 let root = F.inv omega

 and dim = int_power n 2 in

  let m = binary_fft_matrix root n in

   M.matrix_map ( F.int_div dim ) m ;;




(** 
binary_twist_fft_vector twist_factor degree
 *)


let binary_twist_fft_vector = fun (twist:F.t) (n:int) ->

 let dim = int_power n 2

 and bits = ref ( Array.make n false )

 and powers = Array.map F.one ( Array.make n () ) in

  powers.(0) <- twist ;

  let v = Array.map F.one ( Array.make dim () )

  and dd = pred dim in

   for i = 1 to pred n do

    let x = powers.( pred i ) in

     powers.(i) <- F.square x

   done ;

   let f = fun i x -> if x then powers.(i) else F.one () in

    for i = 1 to dd do

     bits := reverse_array ( truncated_bits_of_int n i ) ;

     let factors = Array.mapi f !bits in

      v.(i) <- Array.fold_left F.mult ( F.one () ) factors

    done ;

    M.Full_vector v ;;




(** 
aux_binary_twist_fft_matrix twist_factor degree
 *)


let aux_binary_twist_fft_matrix = fun (twist:F.t) (n:int) ->

 M.vector_to_diag ( binary_twist_fft_vector twist n ) ;;




(** 
binary_twisted_fft_matrix primitive_root_of_unity degree twist_factor
 *)


let binary_twisted_fft_matrix = fun (omega:F.t) (n:int) (twist:F.t) ->

 let m = binary_fft_matrix omega n

 and mm = aux_binary_twist_fft_matrix twist n in

  M.matrix_to_full ( M.matrix_mult m mm ) ;;










(** 
§ 
 *)



(** 

Algorithme primaire de Gauss-Runge-Danielson-Lanczos-Cooley-Tukey


Primary algorithm of Gauss-Runge-Danielson-Lanczos-Cooley-Tukey

*)



(** 
 
 *)











(** 
element_primary_fft raw_root radix primitive_root_of_unity degree exponent




La racine primitive de l'unité raw_root doit être d'ordre la base p. 
La racine primitive de l'unité omega doit être d'ordre p^n. *)


let element_primary_fft = fun (raw_root:F.t) (p:int) (omega:F.t) (n:int) (exponent:int) ->

 if n < 0 then failwith "Bad degree in Fft.element_primary_fft." ;

 let dim = Util.int_power n p

 and pp = pred p

 and x = F.int_pow exponent omega in

  let f = fun i j -> scal_block_fft ( F.mult ( F.int_pow i raw_root ) ( F.int_pow j x ) ) dim in

   let init = scal_block_fft ( F.one () ) dim in

    let m = Array.make_matrix p p init in

     for i = 0 to pp do

      let row = m.(i) in

       for j = 1 to pp do

        row.(j) <- f ( ( i * j ) mod p ) j

       done ;

     done ;

     M.matrix_of_blocks m ;;






(** 
factor_primary_fft raw_root radix primitive_root_of_unity degree step




La racine primitive de l'unité raw_root doit être d'ordre la base p. 
La racine primitive de l'unité omega doit être d'ordre p^n. *)


let factor_primary_fft = fun (raw_root:F.t) (p:int) (omega:F.t) (n:int) (step:int) ->

 if n < 2 then failwith "Bad degree in Fft.element_primary_fft." ;

 let nn = pred n in

  if ( step < 0 ) || ( step > nn ) then failwith "Bad step in Fft.element_primary_fft." ;

  let slicing = Util.int_power step p

  and complement = nn - step in

  let small_dim = Util.int_power complement p in

   let z = M.matrix_sparse_null ( Array.make 2 ( p * small_dim ) ) in

    let m = Array.make_matrix slicing slicing z in

     for i = 0 to pred slicing do

      let ii = Util.truncated_digit_reversal p nn i in

       m.(i).(i) <- element_primary_fft raw_root p omega complement ii ;

     done ;

     M.matrix_of_blocks m ;;




(** 
aux_primary_fft_matrix raw_root radix primitive_root_of_unity degree
 *)


let aux_primary_fft_matrix = fun (raw_root:F.t) (p:int) (omega:F.t) (n:int) ->

 let accu = ref ( M.matrix_transpose ( factor_primary_fft raw_root p omega n 0 ) ) in

  for i = 1 to pred n do

   accu := M.matrix_twisted_mult !accu ( factor_primary_fft raw_root p omega n i ) ;

  done ;

  M.matrix_to_full ( M.matrix_transpose !accu ) ;;




(** 
primary_row_mix radix degree matrix
 *)


let primary_row_mix = fun (p:int) (n:int) (m:M.matrix) ->

 let dim = int_power n p in

  for i = 0 to pred dim do

   let ii = truncated_digit_reversal p n i in

    if ( ii > i ) then

     M.matrix_row_exchange i ii m

  done ;;




(** 
primary_fft_matrix raw_root radix primitive_root_of_unity degree
 *)


let primary_fft_matrix = fun (raw_root:F.t) (p:int) (omega:F.t) (n:int) ->

 let m = aux_primary_fft_matrix raw_root p omega n in

  primary_row_mix p n m ;

  m ;;




(** 
inverse_primary_fft_matrix raw_root radix primitive_root_of_unity degree
 *)


let inverse_primary_fft_matrix = fun (raw_root:F.t) (p:int) (omega:F.t) (n:int) ->

 let root = F.inv omega

 and dim = int_power n p in

  let m = primary_fft_matrix raw_root p root n in

   M.matrix_map ( F.int_div dim ) m ;;




(** 
primary_twist_fft_vector radix twist_factor degree
 *)


let primary_twist_fft_vector = fun (p:int) (twist:F.t) (n:int) ->

 let dim = int_power n p

 and pp = pred p

 and p_p = p - 2

 and digits = ref ( Array.make n 0 ) in

  let powers = Array.map ( Array.map F.one ) ( Array.make_matrix n pp () ) in

   let first_row = powers.(0) in

    first_row.(0) <- twist ;

    for j = 1 to p_p do

     first_row.(j) <- F.mult twist first_row. ( pred j )

    done ;

    let v = Array.map F.one ( Array.make dim () )

    and dd = pred dim in

     for i = 1 to pred n do

      let pred_row = powers.( pred i )

      and row = powers.(i) in

       let x = pred_row.(0)

       and y = pred_row.(p_p) in

        let z = F.mult x y in

         row.(0) <- z ;

         for j = 1 to p_p do

          row.(j) <- F.mult row.( pred j ) z

         done ;

     done ;

     let f = fun i x -> if x > 0 then powers.(i).( pred x ) else F.one () in

     for i = 1 to dd do

      digits := reverse_array ( truncated_digits_of_int p n i ) ;

      let factors = Array.mapi f !digits in

       v.(i) <- Array.fold_left F.mult ( F.one () ) factors

      done ;

      M.Full_vector v ;;




(** 
aux_primary_twist_fft_matrix radix twist_factor degree
 *)


let aux_primary_twist_fft_matrix = fun (p:int) (twist:F.t) (n:int) ->

 M.vector_to_diag ( primary_twist_fft_vector p twist n ) ;;




(** 
primary_twisted_fft_matrix raw_root radix primitive_root_of_unity degree twist_factor
 *)


let primary_twisted_fft_matrix = fun (raw_root:F.t) (p:int) (omega:F.t) (n:int) (twist:F.t) ->

 let m = primary_fft_matrix raw_root p omega n

 and mm = aux_primary_twist_fft_matrix p twist n in

  M.matrix_to_full ( M.matrix_mult m mm ) ;;










(** 
§ 
 *)



(** 

Fonctions vectorielles


Vector functions

*)



(** 
 
 *)











(** 
§ 
 *)



(** 

Algorithme binaire de Gauss-Runge-Danielson-Lanczos-Cooley-Tukey


Binary algorithm of Gauss-Runge-Danielson-Lanczos-Cooley-Tukey

*)



(** 
 
 *)











(** 
naive_vector_binary_mix degree vector
 *)


let naive_vector_binary_mix = fun (n:int) (v:M.vector) ->

 let dim = int_power n 2 in

  for i = 0 to pred dim do

   let ii = truncated_bit_reversal n i in

    if ( ii > i ) then

     M.vector_exchange i ii v

  done ;;




(** 
vector_binary_mix degree vector
 *)


let vector_binary_mix = fun (n:int) (v:M.vector) ->

 let f = function ( i , x ) ->

  begin

   let ii = truncated_bit_reversal n i in

    if ( ii > i ) then

     M.vector_exchange i ii v

  end in

  M.vector_iter f v ;;




(** 
extract_odd vector
 *)


let extract_odd = function (v:M.vector)->

 let ( dd , h ) = M.vector_sparse_demakeup ( M.vector_to_sparse ( M.vector_nihil v ) ) in

  M.V.H.resize ( max 1 ( ( abs ( M.V.H.size h ) ) / 2 ) ) h ;

  let result = M.Sparse_vector ( dd / 2 , h ) in

   let f = function ( i , x ) ->

    begin

     if i land 1 <> 0 then

      M.vector_insert_add x ( i / 2 ) result 

    end in

    M.vector_iter f v ;

    result ;;




(** 
extract_even vector
 *)


let extract_even = function (v:M.vector)->

 let ( dd , h ) = M.vector_sparse_demakeup ( M.vector_to_sparse ( M.vector_nihil v ) ) in

  M.V.H.resize ( max 1 ( ( abs ( M.V.H.size h ) ) / 2 ) ) h ;

  let result = M.Sparse_vector ( dd / 2 , h ) in

   let f = function ( i , x ) ->

    begin

     if i land 1 = 0 then

      M.vector_insert_add x ( i / 2 ) result 

    end in

    M.vector_iter f v ;

    result ;;






(** 
vector_binary_fft threshold primitive_root_of_unity degree powers matrix_array vector

This function is not tail recursive.
The dimension of the vector v is supposed to be equal to 2^n.



La dimension du vecteur v est supposée égale à 2^n.
Cette fonction n'est pas récursive terminale. *)


let rec vector_binary_fft = fun (threshold:int) (omega:F.t) (n:int) (powers:F.t array) (matrices:M.matrix array) (v:M.vector) ->

 match compare n ( max 2 threshold ) with

 | test when test <= 0 ->

  begin

   try

    begin

     let mat = matrices.(n) in

      let dm = M.matrix_dimensions mat

      and dv = M.vector_dimension v in

       assert ( ( dm.(0) = dv ) && ( dm.(1) = dv ) ) ;

       ( M.matrix_vector_prod mat v , powers , mat )

    end

   with _ ->

    begin

     let mat = binary_fft_matrix omega n in

      ( M.matrix_vector_prod mat v , powers , mat )

    end

  end

 | _ ->

  begin

   let om = F.square omega

   and nn = pred n

   and lp = Array.length powers

   and d = M.vector_dimension v

   and result = M.vector_nihil v

   and odd = extract_odd v

   and even = extract_even v in

    let t = Util.primo ( vector_binary_fft threshold om nn ( Util.extract_even powers ) matrices even )

    and dd = d / 2

    and tt = Util.primo ( vector_binary_fft threshold om nn ( Util.extract_even powers ) matrices odd ) in

     let pow = if lp >= dd then powers

      else

       begin

        let tableau = Array.append powers ( Array.map F.one ( Array.make ( dd - lp ) () ) ) in

        for i = lp to pred dd do

         tableau.(i) <- F.mult omega tableau.( pred i )

        done ;

        tableau

      end in

     let f = function ( i , x ) ->

      begin

       M.vector_insert_add x i result ;

       M.vector_insert_add x ( i + dd ) result ;

      end

     and g = function ( i , x ) ->

      begin

       M.vector_insert_add ( F.mult pow.(i) x ) i result ;

       M.vector_insert_sub ( F.mult pow.(i) x ) ( i + dd ) result ;

      end in

      M.vector_iter f t ;

      M.vector_iter g tt ;

      ( result , pow , M.matrix_zero () )

  end ;;






(** 
vector_inverse_binary_fft threshold primitive_root_of_unity degree inverse_powers matrix_array vector

This function is not tail recursive.
The dimension of the vector v is supposed to be equal to 2^n.



La dimension du vecteur v est supposée égale à 2^n.
Cette fonction n'est pas récursive terminale. *)


let rec vector_inverse_binary_fft = fun (threshold:int) (omega:F.t) (n:int) (powers:F.t array) (matrices:M.matrix array) (v:M.vector) ->

 match compare n ( max 2 threshold ) with

 | test when test <= 0 ->

  begin

   try

    begin

     let mat = matrices.(n) in

      let dm = M.matrix_dimensions mat

      and dv = M.vector_dimension v in

       assert ( ( dm.(0) = dv ) && ( dm.(1) = dv ) ) ;

       ( M.matrix_vector_prod mat v , powers , mat )

    end

   with _ ->

    begin

     let mat = inverse_binary_fft_matrix omega n in

      ( M.matrix_vector_prod mat v , powers , mat )

    end

  end

 | _ ->

  begin

   let om = F.square omega

   and inv_omega = F.inv omega

   and half = F.int_div 2 ( F.one () )

   and nn = pred n

   and lp = Array.length powers

   and d = M.vector_dimension v

   and result = M.vector_nihil v

   and odd = extract_odd v

   and even = extract_even v in

    let t = Util.primo ( vector_inverse_binary_fft threshold om nn ( Util.extract_even powers ) matrices even )

    and dd = d / 2

    and tt = Util.primo ( vector_inverse_binary_fft threshold om nn ( Util.extract_even powers ) matrices odd ) in

     let pow = if lp >= dd then powers

      else

       begin

        let tableau = Array.append powers ( Array.map F.one ( Array.make ( dd - lp ) () ) ) in

        for i = lp to pred dd do

         tableau.(i) <- F.mult inv_omega tableau.( pred i )

        done ;

        tableau

      end in

     let f = function ( i , x ) ->

      begin

       M.vector_insert_add x i result ;

       M.vector_insert_add x ( i + dd ) result ;

      end

     and g = function ( i , x ) ->

      begin

       M.vector_insert_add ( F.mult pow.(i) x ) i result ;

       M.vector_insert_sub ( F.mult pow.(i) x ) ( i + dd ) result ;

      end in

      M.vector_iter f t ;

      M.vector_iter g tt ;

      ( M.vector_scal_mult ( half ) result , pow , M.matrix_zero () )

  end ;;




























(** 
§ § § 
 *)






end ;;






















(** 
§ § § 
 *)






end ;;



















module Readwrite = struct










(** 
§ 
 *)



(** 

Introduction

*)



(** 
 
 *)











(**
The mathematician will find in this module:



    

  • utility functions in order to permit the following exchanges between Ocaml and the file system:
    • 



    

  1. read and write integer or real vectors and matrices,
    2. 

  2. read and write text files, 
    3. 

  3. read XPM picture files (which are text files indeed),
    4. 

  4. read PNM picture files of type P4, which means bitmap pictures in binary data,
    5. 

  5. read and write PNM picture files of types P5 and P6, which means gray levels pictures (PGM) or trichromic pictures (PPM) in binary data,
    6. 

  6. read and write BMP picture files,
    7. 

  7. read and write sound files in the AU float 32 bits format, 
    8. 

  8. read and write real vectors and matrices in the AU float 64 bits format,
    9. 

  9. read and write sound files in some WAV format,
    10. 

  10. read the directories,
    11. 



    

  • methods to treat the characters obtained from these files,
    • 



    

  • conversions between different ways to record pictures inside Ocaml,
    • 



    

  • utility functions in order to retrieve data about the environment of the operating system.
    • 




Conventions




The color used in the Graphics module of Ocaml is coded by an integer according to the formula
color = red * 256 * 256 + green * 256 + blue
where the integers red, green, blue are between 0 and 255.




Comments




The reading and writing of float 64 bits AU sound files (real vectors and matrices) makes use of
the commands head and tail available on every minimal UNIX system.



The reading and writing of float 32 bits AU sound files (real vectors) makes use of
conversions with the class int which are only correct on 64 bits machines.



The functions about environment use instructions that vary considerably 
from one operating system to another. They have been only tested under FreeBSD.



The functions for reading the content of a file into a list and writing the content of a file from an Ocaml structure come from P. Manoury: 
Programmation de droite à gauche et vice-versa, Paracamplus, Paris, 2011:



www.paracamplus.com



This module is distributed under the same licence as Ocaml.




§ 




La mathématicienne ou le mathématicien trouvera dans ce module :



    

  • des fonctions utilitaires permettant les échanges suivants entre Ocaml et le système de fichiers : 
    • 



    

  1. lecture et écriture des vecteurs et matrices entiers ou réels,
    2. 

  2. lecture et écriture des fichiers textes, 
    3. 

  3. lecture des fichiers d'images XPM (qui sont en fait des fichiers textes), 
    4. 

  4. lecture des fichiers d'images PNM de type P4, c'est-à-dire des images noir-blanc en données binaires,
    5. 

  5. lecture et écriture des fichiers d'images PNM de types P5 et P6, c'est-à-dire des images soit en niveaux de gris (PGM) soit trichromiques (PPM) en données binaires,
    6. 

  6. lecture et écriture des fichiers d'images BMP,
    7. 

  7. lecture et écriture des fichiers sons au format AU float 32 bits, 
    8. 

  8. lecture et écriture des vecteurs et matrices réels au format AU float 64 bits,
    9. 

  9. lecture et écriture de fichiers sons à certains formats WAV,
    10. 

  10. lecture des répertoires,
    11. 



    

  • des méthodes pour traiter les caractères obtenus de ces fichiers,
    • 



    

  • des conversions entre différentes manières de consigner les images à l'intérieur d'Ocaml,
    • 



    

  • des fonctions utilitaires permettant de récupérer des données sur l'environnement du système d'exploitation.
    • 




Conventions




La couleur utilisée dans le module Graphics d'Ocaml est codée par entier selon la formule
couleur = rouge * 256 * 256 + vert * 256 + bleu 
où les entiers rouge, vert, bleu sont compris entre 0 et 255.




Commentaires




La lecture et l'écriture de fichiers sons AU float 64 bits (vecteurs et matrices réels)
utilise les commandes head et tail fournies dans tous les systèmes UNIX minimaux.



La lecture et l'écriture des fichiers sons AU float 32 bits utilisent des conversions avec 
la classe int qui ne sont correctes que sur les machines 64 bits.



Les informations sur l'environnement utilisent des instructions qui varient fortement
d'un système d'exploitation à l'autre. Elles ne sont testées que sous FreeBSD.



Les fonctions de lecture d'un fichier vers une liste ou d'écriture d'un fichier depuis une structure d'Ocaml proviennent de P. Manoury : 
Programmation de droite à gauche et vice-versa, Paracamplus, Paris, 2011 :



www.paracamplus.com



Ce module est distribué selon la même licence qu'Ocaml.




Copyright Stéphane Grognet 


Laboratoire de mathématiques Jean Leray UMR 6629 CNRS 


Fédération de recherche mathématique des Pays de la Loire 


IREM des Pays de la Loire - Université de Nantes 


version 0.3

*)



(**
@version 0.3
*)



(**
@author Stéphane Grognet
*)



(**
@since 2013
*)










open Util ;;

open Matrix ;;










(** 
§ 
 *)



(** 

Fichiers textes, fichiers binaires et traitement des chaînes de caractères


Text files, binary files and character strings treatment

*)



(** 
 
 *)











(** 
string_match regexp string start
 *)


let string_match = fun r s i ->

 try

  begin

   ignore ( Str.search_forward r s i ) ;

   true

  end

 with Not_found -> false ;;




(** 
list_read_reverse_text_file file_name
 *)


let list_read_reverse_text_file = function (fname:string) ->

 let ic = open_in fname in

   let l = ref [] in

    begin

     try

      while true do

       l := ( input_line ic ) :: !l ;

      done

     with End_of_file -> close_in_noerr ic

    end ;

    !l ;;




(** 
list_read_reverse_text_header file_name
 *)


let list_read_reverse_text_header = fun (h:int) (fname:string) ->

 let ic = open_in fname in

   let l = ref [] in

    begin

     try

      for i = 1 to h do

       l := ( input_line ic ) :: !l ;

      done ;

      close_in_noerr ic

     with End_of_file -> close_in_noerr ic

    end ;

    !l ;;






(** 
list_read_text_file file_name
 *)


let list_read_text_file = function (fname:string) ->

 List.rev ( list_read_reverse_text_file fname ) ;;




(** 
array_read_reverse_text_file file_name
 *)


let array_read_reverse_text_file = function (fname:string) ->

 Array.of_list ( list_read_reverse_text_file fname ) ;;




(** 
array_read_text_file file_name
 *)


let array_read_text_file = function (fname:string) ->

 Array.of_list ( list_read_text_file fname ) ;;






(** 
list_write_text_file string_list file_name
 *)


let list_write_text_file = fun (l:string list) (fname:string) ->

 let oc = open_out fname

 and ll = ref l in

  while List.length !ll > 0 do

   output_string oc ( ( List.hd !ll ) ^ "\n" ) ;

   ll := List.tl !ll

  done ;

  close_out_noerr oc ;;




(** 
array_write_text_file string_array file_name
 *)


let array_write_text_file = fun (a:string array) (fname:string) ->

 let oc = open_out fname

 and l = Array.length a in

  for i = 0 to pred l do

   output_string oc ( a.(i) ^ "\n" ) ;

  done ;

  close_out_noerr oc ;;






(** 
list_read_text_header size file_name
 *)


let list_read_text_header = fun (h:int) (fname:string) ->

 List.rev ( list_read_reverse_text_header h fname ) ;;




(** 
array_read_reverse_text_header size file_name
 *)


let array_read_reverse_text_header = fun (h:int) (fname:string) ->

 Array.of_list ( list_read_reverse_text_header h fname ) ;;




(** 
array_read_text_header size file_name
 *)


let array_read_text_header = fun (h:int) (fname:string) ->

 Array.of_list ( list_read_text_header h fname ) ;;






(** 
list_read_reverse_binary_file file_name
 *)


let list_read_reverse_binary_file = function (fname:string) ->

 let ic = open_in_bin fname in

   let l = ref [] in

    begin

     try

      while true do

       l := ( input_byte ic ) :: !l

      done

     with End_of_file -> close_in_noerr ic

    end ;

    !l ;;




(** 
list_read_binary_file file_name
 *)


let list_read_binary_file = function (fname:string) ->

 List.rev ( list_read_reverse_binary_file fname ) ;;






(** 
step_read_binary_file buffer block_size file_name
 *)


let rec step_read_binary_file = fun (b:Buffer.t) (block_size:int) (ic:in_channel) ->

 try

  begin

   Buffer.add_channel b ic block_size ;

   block_size

  end

 with _ ->

  block_size / 2 ;;




(** 
buffer_to_binary_array buffer
 *)


let buffer_to_binary_array = function (b:Buffer.t) ->

 let r = Buffer.length b in

  let a = Array.make r 0 in

   for i = 0 to pred r do

    a.(i) <- int_of_char ( Buffer.nth b i )

   done ;

   a ;;




(** 
array_read_binary_file init_size file_name
 *)


let rec array_read_binary_file = fun (init_size:int) (fname:string) ->

 let b = Buffer.create init_size

 and block_size = ref init_size

 and ic = open_in_bin fname in

  let f = function () ->

   begin

    block_size := step_read_binary_file b !block_size ic ;

    !block_size >= 1

   end in

   while ( f () ) do

    ()

   done ;

   buffer_to_binary_array b ;;








(** 
array_write_binary_file vector file_name
 *)


let array_write_binary_file = fun a (fname:string) ->

 let l = Array.length a

 and oc = open_out fname in

  for i = 0 to pred l do

   output_byte oc a.(i)

  done ;

  close_out_noerr oc ;;






(** 
hexa_char_to_int figure
 *)


let hexa_char_to_int = function (c:char) ->

 match c with

 | '0' -> 0

 | '1' -> 1

 | '2' -> 2

 | '3' -> 3

 | '4' -> 4

 | '5' -> 5

 | '6' -> 6

 | '7' -> 7

 | '8' -> 8

 | '9' -> 9

 | 'A' -> 10

 | 'B' -> 11

 | 'C' -> 12

 | 'D' -> 13

 | 'E' -> 14

 | 'F' -> 15

 | 'a' -> 10

 | 'b' -> 11

 | 'c' -> 12

 | 'd' -> 13

 | 'e' -> 14

 | 'f' -> 15

 | _ -> failwith "Hexadecimal character not recognized in Readwrite.hexa_char_to_int." ;;

 


(** 
int_to_hexa_char figure
 *)


let int_to_hexa_char = function (c:int) ->

 match c with

 | 0 -> '0'

 | 1 -> '1'

 | 2 -> '2'

 | 3 -> '3'

 | 4 -> '4'

 | 5 -> '5'

 | 6 -> '6'

 | 7 -> '7'

 | 8 -> '8'

 | 9 -> '9'

 | 10 -> 'A'

 | 11 -> 'B'

 | 12 -> 'C'

 | 13 -> 'D'

 | 14 -> 'E'

 | 15 -> 'F'

 | _ -> failwith "Hexadecimal figure not allowed in Readwrite.int_to_hexa_char." ;;

 


(** 
byte_string_to_int string
 *)


let byte_string_to_int = function (s:string) ->

 let a = hexa_char_to_int s.[0]

 and b = hexa_char_to_int s.[1] in

  16 * a + b ;;




(** 
triple_byte_string_to_int_luminance string
 *)


let triple_byte_string_to_int_luminance = function (s:string) ->


(** The string begins with a #. *)


 let indices = [| 1 ; 2 ; 3 ; 4 ; 5 ; 6 |]

 and f = function i -> hexa_char_to_int s.[i] in

  let v = Array.map f indices in

   16 * ( v.(0) + v.(2) + v.(4) ) + v.(1) + v.(3) + v.(5) ;;




(** 
triple_byte_string_to_int_red string
 *)


let triple_byte_string_to_int_red = function (s:string) ->


(** The string begins with a #. *)


 let a = hexa_char_to_int s.[1]

 and b = hexa_char_to_int s.[2] in

  16 * a + b ;;




(** 
triple_byte_string_to_int_green string
 *)


let triple_byte_string_to_int_green = function (s:string) ->


(** The string begins with a #. *)


 let a = hexa_char_to_int s.[3]

 and b = hexa_char_to_int s.[4] in

  16 * a + b ;;




(** 
triple_byte_string_to_int_blue string
 *)


let triple_byte_string_to_int_blue = function (s:string) ->


(** The string begins with a #. *)


 let a = hexa_char_to_int s.[5]

 and b = hexa_char_to_int s.[6] in

  16 * a + b ;;




(** 
triple_byte_string_to_int_rgb string
 *)


let triple_byte_string_to_int_rgb = function (s:string) ->


(** The string begins with a #. *)


 let indices = [| 1 ; 2 ; 3 ; 4 ; 5 ; 6 |]

 and f = function i -> hexa_char_to_int s.[i] in

  let v = Array.map f indices in

   [| 16 * v.(0) + v.(1) ; 16 * v.(2) + v.(3) ; 16 * v.(4) + v.(5) |] ;;




(** 
triple_byte_string_to_color string
 *)


let triple_byte_string_to_color = function (s:string) ->


(** The string begins with a #. *)


 let indices = [| 1 ; 2 ; 3 ; 4 ; 5 ; 6 |]

 and f = function i -> hexa_char_to_int s.[i] in

  let v = Array.map f indices in

   ((((( 16 * v.(0) ) + v.(1) ) * 16 + v.(2) ) * 16 + v.(3) ) * 16 + v.(4) ) * 16 + v.(5) ;;






(** 
hexa_char_to_float figure
 *)


let hexa_char_to_float = function (c:char) ->

 match c with

 | '0' -> 0.

 | '1' -> 1.

 | '2' -> 2.

 | '3' -> 3.

 | '4' -> 4.

 | '5' -> 5.

 | '6' -> 6.

 | '7' -> 7.

 | '8' -> 8.

 | '9' -> 9.

 | 'A' -> 10.

 | 'B' -> 11.

 | 'C' -> 12.

 | 'D' -> 13.

 | 'E' -> 14.

 | 'F' -> 15.

 | 'a' -> 10.

 | 'b' -> 11.

 | 'c' -> 12.

 | 'd' -> 13.

 | 'e' -> 14.

 | 'f' -> 15.

 | _ -> failwith "Hexadecimal character not recognized in Readwrite.hexa_char_to_float." ;;

 


(** 
byte_string_to_float string
 *)


let byte_string_to_float = function (s:string) ->

 let a = hexa_char_to_float s.[0]

 and b = hexa_char_to_float s.[1] in

  16. *. a +. b ;;




(** 
triple_byte_string_to_float_luminance string
 *)


let triple_byte_string_to_float_luminance = function (s:string) ->


(** The string begins with a #. *)


 let indices = [| 1 ; 2 ; 3 ; 4 ; 5 ; 6 |]

 and f = function i -> hexa_char_to_float s.[i] in

  let v = Array.map f indices in

   16. *. ( v.(0) +. v.(2) +. v.(4) ) +. v.(1) +. v.(3) +. v.(5) ;;




(** 
triple_byte_string_to_float_red string
 *)


let triple_byte_string_to_float_red = function (s:string) ->


(** The string begins with a #. *)


 let a = hexa_char_to_float s.[1]

 and b = hexa_char_to_float s.[2] in

  16. *. a +. b ;;




(** 
triple_byte_string_to_float_green string
 *)


let triple_byte_string_to_float_green = function (s:string) ->


(** The string begins with a #. *)


 let a = hexa_char_to_float s.[3]

 and b = hexa_char_to_float s.[4] in

  16. *. a +. b ;;




(** 
triple_byte_string_to_float_blue string
 *)


let triple_byte_string_to_float_blue = function (s:string) ->


(** The string begins with a #. *)


 let a = hexa_char_to_float s.[5]

 and b = hexa_char_to_float s.[6] in

  16. *. a +. b ;;




(** 
triple_byte_string_to_float_rgb string
 *)


let triple_byte_string_to_float_rgb = function (s:string) ->


(** The string begins with a #. *)


 let indices = [| 1 ; 2 ; 3 ; 4 ; 5 ; 6 |]

 and f = function i -> hexa_char_to_float s.[i] in

  let v = Array.map f indices in

   [| 16. *. v.(0) +. v.(1) ; 16. *. v.(2) +. v.(3) ; 16. *. v.(4) +. v.(5) |] ;;






(** 
gray_string_to_float_luminance string
 *)


let gray_string_to_float_luminance = function (s:string) ->

 let l = String.length s in

  let c = String.sub s 4 ( l - 4 ) in

   let n = float_of_string c in

    7.65 *. n ;;




(** 
gray_string_to_float_unicolor string
 *)


let gray_string_to_float_unicolor = function (s:string) ->

 let l = String.length s in


(** The character "G" has been suppressed. *)


  let c = String.sub s 4 ( l - 4 ) in

   let n = float_of_string c in

    2.55 *. n ;;




(** 
gray_string_to_float_rgb string
 *)


let gray_string_to_float_rgb = function (s:string) ->

 let c = gray_string_to_float_unicolor s in

  Array.make 3 c ;;




(** 
gray_string_to_int_unicolor string
 *)


let gray_string_to_int_unicolor = function (s:string) ->

 min 255 ( Util.round ( gray_string_to_float_unicolor s ) ) ;;




(** 
gray_string_to_int_luminance string
 *)


let gray_string_to_int_luminance = function (s:string) ->

 min 255 ( Util.round ( gray_string_to_float_luminance s ) ) ;;




(** 
gray_string_to_int_rgb string
 *)


let gray_string_to_int_rgb = function (s:string) ->

 let c = gray_string_to_int_unicolor s in

  Array.make 3 c ;;




(** 
gray_string_to_color string
 *)


let gray_string_to_color = function (s:string) ->

 min 16777215 ( 65793 * ( Util.round ( gray_string_to_float_unicolor s ) ) ) ;;






(** 
name_to_triple_byte string
 *)


let name_to_triple_byte = function (s:string) ->

 match s with

 | "AntiqueWhite" -> "#FAEBD7"

 | "Aqua" -> "#00FFFF"

 | "Aquamarine" -> "#7FFFD4"

 | "Azure" -> "#F0FFFF"

 | "Beige" -> "#F5F5DC"

 | "Bisque" -> "#FFE4C4"

 | "Black" -> "#000000"

 | "BlanchedAlmond" -> "#FFEBCD"

 | "Blue" -> "#0000FF"

 | "BlueViolet" -> "#8A2BE2"

 | "Brown" -> "#A52A2A"

 | "Burlywood" -> "#DEB887"

 | "CadetBlue" -> "#5F9EA0"

 | "Chartreuse" -> "#7FFF00"

 | "Chocolate" -> "#D2691E"

 | "Coral" -> "#FF7F50"

 | "Cornflower" -> "#6495ED"

 | "Cornsilk" -> "#FFF8DC"

 | "Crimson" -> "#DC143C"

 | "Cyan" -> "#00FFFF"

 | "DarkBlue" -> "#00008B"

 | "DarkCyan" -> "#008B8B"

 | "DarkGoldenrod" -> "#B8860B"

 | "DarkGray" -> "#A9A9A9"

 | "DarkGreen" -> "#006400"

 | "DarkKhaki" -> "#BDB76B"

 | "DarkMagenta" -> "#8B008B"

 | "DarkOliveGreen" -> "#556B2F"

 | "DarkOrange" -> "#FF8C00"

 | "DarkOrchid" -> "#9932CC"

 | "DarkRed" -> "#8B0000"

 | "DarkSalmon" -> "#E9967A"

 | "DarkSeaGreen" -> "#8FBC8F"

 | "DarkSlateBlue" -> "#483D8B"

 | "DarkSlateGray" -> "#2F4F4F"

 | "DarkTurquoise" -> "#00CED1"

 | "DarkViolet" -> "#9400D3"

 | "DeepPink" -> "#FF1493"

 | "DeepSkyBlue" -> "#00BFFF"

 | "DimGray" -> "#696969"

 | "DodgerBlue" -> "#1E90FF"

 | "Firebrick" -> "#B22222"

 | "FloralWhite" -> "#FFFAF0"

 | "ForestGreen" -> "#228B22"

 | "Fuchsia" -> "#FF00FF"

 | "Gainsboro" -> "#DCDCDC"

 | "GhostWhite" -> "#F8F8FF"

 | "Gold" -> "#FFD700"

 | "Goldenrod" -> "#DAA520"

 | "Gray" -> "#BEBEBE"

 | "Green" -> "#00FF00"

 | "GreenYellow" -> "#ADFF2F"

 | "Honeydew" -> "#F0FFF0"

 | "HotPink" -> "#FF69B4"

 | "IndianRed" -> "#CD5C5C"

 | "Indigo" -> "#4B0082"

 | "Ivory" -> "#FFFFF0"

 | "Khaki" -> "#F0E68C"

 | "Lavender" -> "#E6E6FA"

 | "LavenderBlush" -> "#FFF0F5"

 | "LawnGreen" -> "#7CFC00"

 | "LemonChiffon" -> "#FFFACD"

 | "LightBlue" -> "#ADD8E6"

 | "LightCoral" -> "#F08080"

 | "LightCyan" -> "#E0FFFF"

 | "LightGoldenrod" -> "#FAFAD2"

 | "LightGray" -> "#D3D3D3"

 | "LightGreen" -> "#90EE90"

 | "LightPink" -> "#FFB6C1"

 | "LightSalmon" -> "#FFA07A"

 | "LightSeaGreen" -> "#20B2AA"

 | "LightSkyBlue" -> "#87CEFA"

 | "LightSlateGray" -> "#778899"

 | "LightSteelBlue" -> "#B0C4DE"

 | "LightYellow" -> "#FFFFE0"

 | "Lime" -> "#00FF00"

 | "LimeGreen" -> "#32CD32"

 | "Linen" -> "#FAF0E6"

 | "Magenta" -> "#FF00FF"

 | "Maroon" -> "#B03060"

 | "MediumAquamarine" -> "#66CDAA"

 | "MediumBlue" -> "#0000CD"

 | "MediumOrchid" -> "#BA55D3"

 | "MediumPurple" -> "#9370DB"

 | "MediumSeaGreen" -> "#3CB371"

 | "MediumSlateBlue" -> "#7B68EE"

 | "MediumSpringGreen" -> "#00FA9A"

 | "MediumTurquoise" -> "#48D1CC"

 | "MediumVioletRed" -> "#C71585"

 | "MidnightBlue" -> "#191970"

 | "MintCream" -> "#F5FFFA"

 | "MistyRose" -> "#FFE4E1"

 | "Moccasin" -> "#FFE4B5"

 | "NavajoWhite" -> "#FFDEAD"

 | "Navy" -> "#000080"

 | "OldLace" -> "#FDF5E6"

 | "Olive" -> "#808000"

 | "OliveDrab" -> "#6B8E23"

 | "Orange" -> "#FFA500"

 | "OrangeRed" -> "#FF4500"

 | "Orchid" -> "#DA70D6"

 | "PaleGoldenrod" -> "#EEE8AA"

 | "PaleGreen" -> "#98FB98"

 | "PaleTurquoise" -> "#AFEEEE"

 | "PaleVioletRed" -> "#DB7093"

 | "PapayaWhip" -> "#FFEFD5"

 | "PeachPuff" -> "#FFDAB9"

 | "Peru" -> "#CD853F"

 | "Pink" -> "#FFC0CB"

 | "Plum" -> "#DDA0DD"

 | "PowderBlue" -> "#B0E0E6"

 | "Purple" -> "#A020F0"

 | "Red" -> "#FF0000"

 | "RosyBrown" -> "#BC8F8F"

 | "RoyalBlue" -> "#4169E1"

 | "SaddleBrown" -> "#8B4513"

 | "Salmon" -> "#FA8072"

 | "SandyBrown" -> "#F4A460"

 | "SeaGreen" -> "#2E8B57"

 | "Seashell" -> "#FFF5EE"

 | "Sienna" -> "#A0522D"

 | "Silver" -> "#C0C0C0"

 | "SkyBlue" -> "#87CEEB"

 | "SlateBlue" -> "#6A5ACD"

 | "SlateGray" -> "#708090"

 | "Snow" -> "#FFFAFA"

 | "SpringGreen" -> "#00FF7F"

 | "SteelBlue" -> "#4682B4"

 | "Tan" -> "#D2B48C"

 | "Teal" -> "#008080"

 | "Thistle" -> "#D8BFD8"

 | "Tomato" -> "#FF6347"

 | "Turquoise" -> "#40E0D0"

 | "Violet" -> "#EE82EE"

 | "Wheat" -> "#F5DEB3"

 | "White" -> "#FFFFFF"

 | "WhiteSmoke" -> "#F5F5F5"

 | "Yellow" -> "#FFFF00"

 | "YellowGreen" -> "#9ACD32"

 | _ -> failwith "Not an X11 color name in Readwrite.name_to_triple_byte." ;;




(** 
string_to_float_red string
 *)


let string_to_float_red = function (s:string) ->

 if s.[0] = '#' then triple_byte_string_to_float_red s

 else

  begin

  if Str.string_match ( Str.regexp "Gray[0-9]" ) s 0 then

   gray_string_to_float_unicolor s

  else

   triple_byte_string_to_float_red ( name_to_triple_byte s )

  end ;;




(** 
string_to_float_green string
 *)


let string_to_float_green = function (s:string) ->

 if s.[0] = '#' then triple_byte_string_to_float_green s

 else

  begin

  if Str.string_match ( Str.regexp "Gray[0-9]" ) s 0 then

   gray_string_to_float_unicolor s

  else

   triple_byte_string_to_float_green ( name_to_triple_byte s )

  end ;;




(** 
string_to_float_blue string
 *)


let string_to_float_blue = function (s:string) ->

 if s.[0] = '#' then triple_byte_string_to_float_blue s

 else

  begin

  if Str.string_match ( Str.regexp "Gray[0-9]" ) s 0 then

   gray_string_to_float_unicolor s

  else

   triple_byte_string_to_float_blue ( name_to_triple_byte s )

  end ;;




(** 
string_to_float_luminance string
 *)


let string_to_float_luminance = function (s:string) ->

 if s.[0] = '#' then triple_byte_string_to_float_luminance s

 else

  begin

  if Str.string_match ( Str.regexp "Gray[0-9]" ) s 0 then

   gray_string_to_float_luminance s

  else

   triple_byte_string_to_float_luminance ( name_to_triple_byte s )

  end ;;




(** 
string_to_float_rgb string
 *)


let string_to_float_rgb = function (s:string) ->

 if s.[0] = '#' then triple_byte_string_to_float_rgb s

 else

  begin

  if Str.string_match ( Str.regexp "Gray[0-9]" ) s 0 then

   gray_string_to_float_rgb s

  else

   triple_byte_string_to_float_rgb ( name_to_triple_byte s )

  end ;;






(** 
string_to_int_red string
 *)


let string_to_int_red = function (s:string) ->

 if s.[0] = '#' then triple_byte_string_to_int_red s

 else

  begin

  if Str.string_match ( Str.regexp "Gray[0-9]" ) s 0 then

   gray_string_to_int_unicolor s

  else

   triple_byte_string_to_int_red ( name_to_triple_byte s )

  end ;;




(** 
string_to_int_green string
 *)


let string_to_int_green = function (s:string) ->

 if s.[0] = '#' then triple_byte_string_to_int_green s

 else

  begin

  if Str.string_match ( Str.regexp "Gray[0-9]" ) s 0 then

   gray_string_to_int_unicolor s

  else

   triple_byte_string_to_int_green ( name_to_triple_byte s )

  end ;;




(** 
string_to_int_blue string
 *)


let string_to_int_blue = function (s:string) ->

 if s.[0] = '#' then triple_byte_string_to_int_blue s

 else

  begin

  if Str.string_match ( Str.regexp "Gray[0-9]" ) s 0 then

   gray_string_to_int_unicolor s

  else

   triple_byte_string_to_int_blue ( name_to_triple_byte s )

  end ;;




(** 
string_to_int_luminance string
 *)


let string_to_int_luminance = function (s:string) ->

 if s.[0] = '#' then triple_byte_string_to_int_luminance s

 else

  begin

  if Str.string_match ( Str.regexp "Gray[0-9]" ) s 0 then

   gray_string_to_int_luminance s

  else

   triple_byte_string_to_int_luminance ( name_to_triple_byte s )

  end ;;




(** 
string_to_int_rgb string
 *)


let string_to_int_rgb = function (s:string) ->

 if s.[0] = '#' then triple_byte_string_to_int_rgb s

 else

  begin

  if Str.string_match ( Str.regexp "Gray[0-9]" ) s 0 then

   gray_string_to_int_rgb s

  else

   triple_byte_string_to_int_rgb ( name_to_triple_byte s )

  end ;;




(** 
string_to_color string
 *)


let string_to_color = function (s:string) ->

 if s.[0] = '#' then triple_byte_string_to_color s

 else

  begin

  if Str.string_match ( Str.regexp "Gray[0-9]" ) s 0 then

   gray_string_to_color s

  else

   triple_byte_string_to_color ( name_to_triple_byte s )

  end ;;






(** 
read_float_value file_name
 *)


let read_float_value = function (fname:string) ->

( let ic = open_in fname in

   let z = input_value ic in

    close_in_noerr ic ;

    z : float ) ;;




(** 
read_float_array_value file_name
 *)


let read_float_array_value = function (fname:string) ->

( let ic = open_in fname in

   let z = input_value ic in

    close_in_noerr ic ;

    z : float array ) ;;




(** 
write_float_value real file_name
 *)


let write_float_value = fun (x:float) (fname:string) ->

 let oc = open_out fname in

  output_value oc x ;

   close_out_noerr oc ;;




(** 
write_float_array_value real_vector file_name
 *)


let write_float_array_value = fun (x:float array) (fname:string) ->

 let oc = open_out fname in

  output_value oc x ;

   close_out_noerr oc ;;










(** 
§ 
 *)



(** 

Conversions d'images


Picture conversions

*)



(** 
 
 *)











(** 
color_to_int_rgb color
 *)


let color_to_int_rgb = function (c:int) ->

 let r = c / 65536 and g = ( c / 256 ) mod 256 and b = c mod 256 in

  [| r ; g ; b |] ;;




(** 
color_to_float_rgb color
 *)


let color_to_float_rgb = function (c:int) ->

 let r = c / 65536 and g = ( c / 256 ) mod 256 and b = c mod 256 in

  Array.map float [| r ; g ; b |] ;;






(** 
matrix_color_to_int_rgb color_matrix
 *)


let matrix_color_to_int_rgb = function (m:int array array) ->

 let l = Array.length m

 and c = Array.length m.(0) in

  let cc = pred c

  and r = Array.make_matrix l c 0

  and g = Array.make_matrix l c 0

  and b = Array.make_matrix l c 0 in

   for i = 0 to pred l do

    let row_input = m.(i)

    and row_red = r.(i)

    and row_green = g.(i)

    and row_blue = b.(i) in

     for j = 0 to cc do

      let color = row_input.(j) in

       let couleur = color /256 in

        row_red.(j) <- couleur / 256 ;

        row_green.(j) <- couleur mod 256 ;

        row_blue.(j) <- color mod 256 ;

     done

   done ;

   [| r ; g ; b |] ;;




(** 
matrix_int_rgb_to_color rgb_matrix
 *)


let matrix_int_rgb_to_color = function (m:int array array array) ->

 let red = m.(0)

 and green = m.(1)

 and blue = m.(2) in

  let l = Array.length blue

  and c = Array.length blue.(0) in

   let w = Array.make_matrix l c 0

   and cc = pred c in

    for i = 0 to pred l do

     let row_output = w.(i)

     and row_red = red.(i)

     and row_green = green.(i)

     and row_blue = blue.(i) in

      for j = 0 to cc do

       row_output.(j) <- row_blue.(j) + 256 * ( row_green.(j) + 256 * row_red.(j) )

      done

    done ;

    w ;;




(** 
matrix_int_unicolor_to_color matrix
 *)


let matrix_int_unicolor_to_color = function (m:int array array) ->

 Matrix.matrix_int_scal_mult 65793 m ;;




(** 
matrix_float_rgb_to_int_rgb rgb_matrix
 *)


let matrix_float_rgb_to_int_rgb = function (m:float array array array) ->

 Array.map ( function x -> Matrix.matrix_int_clip 255 ( Matrix.matrix_float_round x ) ) m ;;




(** 
matrix_int_rgb_to_float_rgb rgb_matrix
 *)


let matrix_int_rgb_to_float_rgb = function (m:int array array array) ->

 Array.map Matrix.float_of_matrix m ;;






(** 
matrix_float_rgb_to_color rgb_matrix
 *)


let matrix_float_rgb_to_color = function (m:float array array array) ->

 matrix_int_rgb_to_color ( matrix_float_rgb_to_int_rgb m ) ;;




(** 
matrix_color_to_float_rgb color_matrix
 *)


let matrix_color_to_float_rgb = function (m:int array array) ->

 Array.map Matrix.float_of_matrix ( matrix_color_to_int_rgb m ) ;;




(** 
matrix_float_unicolor_to_color matrix
 *)


let matrix_float_unicolor_to_color = function (m:float array array) ->

 Matrix.matrix_int_clip 16777215 ( Matrix.matrix_int_scal_mult 65793 ( Matrix.matrix_float_round m ) ) ;;






(** 
matrix_float_rgb_to_gray rgb_matrix
 *)


let matrix_float_rgb_to_gray = function (m:float array array array) ->

 let r = m.(0)

 and g = m.(1)

 and b = m.(2)

 and constant = 1. /. 3. in

  let l = Array.length r

  and c = Array.length r.(0) in

   let n = Array.make_matrix l c 0.

   and cc = pred c in

    for i = 0 to pred l do

     let row_output = n.(i)

     and row_red = r.(i)

     and row_green = g.(i)

     and row_blue = b.(i) in

      for j = 0 to cc do

       row_output.(j) <- constant *. ( row_red.(j) +. row_green.(j) +. row_blue.(j) )

      done

    done ;

    n ;;




(** 
matrix_int_rgb_to_gray rgb_matrix
 *)


let matrix_int_rgb_to_gray = function (m:int array array array) ->

 let n = matrix_int_rgb_to_float_rgb m in

  let o = matrix_float_rgb_to_gray n in

   Matrix.matrix_int_clip 255 ( Matrix.matrix_float_round o ) ;;




(** 
matrix_color_to_int_gray color_matrix
 *)


let matrix_color_to_int_gray = function (m:int array array) ->

 let n = matrix_color_to_int_rgb m in

  matrix_int_rgb_to_gray n ;;




(** 
matrix_color_to_float_gray color_matrix
 *)


let matrix_color_to_float_gray = function (m:int array array) ->

 let n = matrix_color_to_float_rgb m in

  matrix_float_rgb_to_gray n ;;






(** 
matrix_int_rgb_to_luminance rgb_matrix
 *)


let matrix_int_rgb_to_luminance = function (m:int array array array) ->

 let r = m.(0)

 and g = m.(1)

 and b = m.(2) in

  let l = Array.length r

  and c = Array.length r.(0) in

   let n = Array.make_matrix l c 0

   and cc = pred c in

    for i = 0 to pred l do

     let row_output = n.(i)

     and row_red = r.(i)

     and row_green = g.(i)

     and row_blue = b.(i) in

      for j = 0 to cc do

       row_output.(j) <- row_red.(j) + row_green.(j) + row_blue.(j)

      done

    done ;

    n ;;




(** 
matrix_color_to_int_luminance color_matrix
 *)


let matrix_color_to_int_luminance = function (m:int array array) ->

 let n = matrix_color_to_int_rgb m in

  matrix_int_rgb_to_luminance n ;;




(** 
matrix_float_rgb_to_luminance rgb_matrix
 *)


let matrix_float_rgb_to_luminance = function (m:float array array array) ->

 let r = m.(0)

 and g = m.(1)

 and b = m.(2) in

  let l = Array.length r

  and c = Array.length r.(0) in

   let n = Array.make_matrix l c 0.

   and cc = pred c in

    for i = 0 to pred l do

     let row_output = n.(i)

     and row_red = r.(i)

     and row_green = g.(i)

     and row_blue = b.(i) in

      for j = 0 to cc do

       row_output.(j) <- row_red.(j) +. row_green.(j) +. row_blue.(j)

      done

    done ;

    n ;;




(** 
matrix_color_to_float_luminance color_matrix
 *)


let matrix_color_to_float_luminance = function (m:int array array) ->

 let n = matrix_color_to_float_rgb m in

  matrix_float_rgb_to_luminance n ;;






(** 
matrix_float_unicolor_under_sample edge matrix
 *)


let matrix_float_unicolor_under_sample = fun (n:int) (m:float array array) ->

 let r = Array.length m

 and c = Array.length m.(0) in

  if ( r mod n != 0 ) || ( c mod n != 0 ) then

   failwith "The edge of the square must be a divisor of the number of lines and of the number of columns of the matrix in Readwrite.matrix_float_unicolor_under_sample." ;

   let rr = r / n

   and cc = c / n

   and f = function x -> Matrix.vector_float_sum ( Matrix.vector_float_demakeup x )

   and s = 1. /. ( float ( n * n ) )

   and nn = pred n in

    let w = Array.make_matrix rr cc 0.

    and row = Array.make cc 0.

    and g = function x -> Matrix.vector_foa_demakeup ( Matrix.vector_foa_cut cc ( Matrix.Float_vector_cons x ) )

    and ccc = pred cc in

     let h = function x -> Array.map f ( g x ) in

      for i = 0 to pred rr do

       let row_output = w.(i)

       and ni = n * i in

        for k = 0 to nn do

         let row_input = h m.( ni + k ) in

          for j = 0 to ccc do

           row.(j) <- row.(j) +. row_input.(j)

          done ;

        done ;

        for j = 0 to ccc do

         row_output.(j) <- row.(j) *. s ;

         row.(j) <- 0.

        done

      done ;

      w ;;






(** 
matrix_float_rgb_under_sample edge rgb_matrix
 *)


let matrix_float_rgb_under_sample = fun (n:int) (m:float array array array) ->

 Array.map ( matrix_float_unicolor_under_sample n ) m ;;




(** 
matrix_int_unicolor_under_sample edge matrix
 *)


let matrix_int_unicolor_under_sample = fun (n:int) (m:int array array) ->

 Matrix.int_of_matrix ( matrix_float_unicolor_under_sample n ( Matrix.float_of_matrix m ) ) ;;




(** 
matrix_int_rgb_under_sample edge rgb_matrix
 *)


let matrix_int_rgb_under_sample = fun (n:int) (m:int array array array) ->

 matrix_float_rgb_to_int_rgb ( matrix_float_rgb_under_sample n ( matrix_int_rgb_to_float_rgb m ) ) ;;






(** 
rgb_crop rgb_matrix beg-row end-row beg-col end-col
 *)


let rgb_crop = fun m (i:int) (ii:int) (j:int) (jj:int) ->

 Array.map ( function x -> Matrix.sub_matrix x i ii j jj ) m ;;




(** 
float_unicolor_magnify factor matrix
 *)


let float_unicolor_magnify = fun (factor:int) (m:float array array) ->

 let r = Array.length m

 and c = Array.length m.(0) in

  let cc = pred c

  and w = Array.make_matrix r c ( Matrix.Float_cons 0. ) in

   for i = 0 to pred r do

    let row_input = m.(i)

    and row_output = w.(i) in

     for j = 0 to cc do

      row_output.(j) <- Matrix.Float_matrix_cons ( Array.make_matrix factor factor row_input.(j) )

     done

   done ;

   Matrix.matrix_float_demakeup ( Matrix.matrix_foa_paste ( Matrix.Foa_matrix_cons w ) ) ;;




(** 
float_rgb_magnify factor rgb_matrix
 *)


let float_rgb_magnify = fun (factor:int) (m:float array array array) ->

 Array.map ( float_unicolor_magnify factor ) m ;;










(** 
§ 
 *)



(** 

Fichiers de vecteurs et matrices


Vector and matrix files

*)



(** 
 
 *)











(** 
vector_int_of_string string
 *)


let vector_int_of_string = function (s:string) ->

 let l = String.length s in

  let st = String.sub s 3 ( l - 6 ) in

   let liste = ref ( Str.split ( Str.regexp_string " ; " ) st ) in

    let ll = List.length !liste in

     let v = Array.make ll 0 in

      for i = 0 to pred ll do

       v.(i) <- int_of_string ( List.hd !liste ) ;

       liste := List.tl !liste ;

      done ;

      v ;;




(** 
vector_int_write vector filename
 *)


let vector_int_write = fun (v:int array) (fname:string) ->

 let oc = open_out fname

 and l = Array.length v in

  for i = 0 to pred l do

   output_string oc ( ( string_of_int v.(i) ) ^ "\n" ) ;

  done ;

  close_out_noerr oc ;;




(** 
matrix_int_write matrix filename
 *)


let matrix_int_write = fun (v:int array array) (fname:string) ->

 let oc = open_out fname

 and l = Array.length v in

  for i = 0 to pred l do

   output_string oc ( ( Matrix.string_of_vector_int v.(i) ) ^ "\n" ) ;

  done ;

  close_out_noerr oc ;;




(** 
list_reverse_int_read
 *)


let list_reverse_int_read = function (fname:string) ->

 let ic = open_in fname in

   let l = ref [] in

    begin

     try

      while true do

       l := ( int_of_string ( input_line ic ) ) :: !l ;

      done

     with End_of_file -> close_in_noerr ic

    end ;

    !l ;;




(** 
list_int_read
 *)


let list_int_read = function (fname:string) ->

 List.rev ( list_reverse_int_read fname ) ;;




(** 
vector_reverse_int_read
 *)


let vector_reverse_int_read = function (fname:string) ->

 Array.of_list ( list_reverse_int_read fname ) ;;




(** 
vector_int_read
 *)


let vector_int_read = function (fname:string) ->

 Array.of_list ( list_int_read fname ) ;;




(** 
matrix_int_read filename
 *)


let matrix_int_read = function (fname:string) ->

 let ic = open_in fname in

   let l = ref []

   and i = ref 0 in

    begin

     try

      while true do

       l := ( input_line ic ) :: !l ;

       i := succ !i ;

      done

     with End_of_file -> close_in_noerr ic

    end ;

    let m = Array.make_matrix ( succ !i ) 0 0 in

     for j = pred !i downto 0 do

      m.(j) <- vector_int_of_string ( List.hd !l ) ;

      l := List.tl !l ;

     done ;

     m ;;






(** 
vector_float_of_string string
 *)


let vector_float_of_string = function (s:string) ->

 let l = String.length s in

  let st = String.sub s 3 ( l - 6 ) in

   let liste = ref ( Str.split ( Str.regexp_string " ; " ) st ) in

    let ll = List.length !liste in

     let v = Array.make ll 0. in

      for i = 0 to pred ll do

       v.(i) <- float_of_string ( List.hd !liste ) ;

       liste := List.tl !liste ;

      done ;

      v ;;




(** 
vector_float_write vector filename
 *)


let vector_float_write = fun (v:float array) (fname:string) ->

 let oc = open_out fname

 and l = Array.length v in

  for i = 0 to pred l do

   output_string oc ( ( string_of_float v.(i) ) ^ "\n" ) ;

  done ;

  close_out_noerr oc ;;




(** 
matrix_float_write matrix filename
 *)


let matrix_float_write = fun (m:float array array) (fname:string) ->

 let oc = open_out fname

 and l = Array.length m in

  for i = 0 to pred l do

   output_string oc ( ( Matrix.string_of_vector_float m.(i) ) ^ "\n" ) ;

  done ;

  close_out_noerr oc ;;




(** 
list_reverse_float_read
 *)


let list_reverse_float_read = function (fname:string) ->

 let ic = open_in fname in

   let l = ref [] in

    begin

     try

      while true do

       l := ( float_of_string ( input_line ic ) ) :: !l ;

      done

     with End_of_file -> close_in_noerr ic

    end ;

    !l ;;




(** 
list_float_read
 *)


let list_float_read = function (fname:string) ->

 List.rev ( list_reverse_float_read fname ) ;;




(** 
vector_reverse_float_read
 *)


let vector_reverse_float_read = function (fname:string) ->

 Array.of_list ( list_reverse_float_read fname ) ;;




(** 
vector_float_read
 *)


let vector_float_read = function (fname:string) ->

 Array.of_list ( list_float_read fname ) ;;




(** 
matrix_float_read filename
 *)


let matrix_float_read = function (fname:string) ->

 let ic = open_in fname in

   let l = ref []

   and i = ref 0 in

    begin

     try

      while true do

       l := ( input_line ic ) :: !l ;

       i := succ !i ;

      done

     with End_of_file -> close_in_noerr ic

    end ;

    let m = Array.make_matrix ( succ !i ) 0 0. in

     for j = pred !i downto 0 do

      m.(j) <- vector_float_of_string ( List.hd !l ) ;

      l := List.tl !l ;

     done ;

     m ;;










(** 
§ 
 *)



(** 

Fichiers d'images xpm


Xpm picture files

*)



(** 
 
 *)











(** The XPM files are of type text; they are supposed to have already been
introduced in the memory of Ocaml as arrays of character strings.



Les fichiers XPM sont de type texte ; on suppose qu'ils ont déja été rentrés 
dans la mémoire d'Ocaml sous forme de tableaux de chaînes de caractères.*)





(** 
xpm_colors_index string_array
 *)


let xpm_colors_index = function (v:string array) ->

 Util.vector_find_first Util.string_eq "/* colors */" v ;;




(** 
xpm_pixels_index string_array
 *)


let xpm_pixels_index = function (v:string array) ->

 Util.vector_find_first Util.string_eq "/* pixels */" v ;;




(** 
xpm_pixels_end string_array
 *)


let xpm_pixels_end = function (v:string array) ->

 Util.vector_find_first Util.string_eq "};" v ;;




(** 
xpm_sizes string_array
 *)


let xpm_sizes = function (v:string array) ->


(** Output format : | width ; height ; ncolors ; chars_per_pixel | *)


 let i = xpm_colors_index v in

  let c = v.( pred i ) in

   let l = String.length c in

    let cc = String.sub c 1 ( l - 3 )

    and r = Str.regexp_string " " in

     let w = Array.of_list ( Str.split r cc ) in

      let x = Array.map int_of_string w in


(** Eliminate the last color : "None". *)


       x.(2) <- pred x.(2) ;

       x ;;




(** 
xpm_colors_strings string_array
 *)


let xpm_colors_strings = function (v:string array) ->

 let i = xpm_colors_index v

 and j = xpm_pixels_index v in


(** Eliminate the last color : "None". *)


  Array.sub v ( succ i ) ( j - i - 2 ) ;;




(** 
xpm_colors_symbols string_array
 *)


let xpm_colors_symbols = function (v:string array) ->

 let l = (xpm_sizes v).(3)

 and c = xpm_colors_strings v in

  let f = function (s:string) -> Str.regexp_string ( String.sub s 1 l ) in

   Array.map f c ;;




(** 
xpm_colors_values string_array
 *)


let xpm_colors_values = function (v:string array) ->

 let l = (xpm_sizes v).(3)

 and c = xpm_colors_strings v in

  let f = function (s:string) ->

   begin

    let tout = Str.string_after s ( 4 + l ) in

     Str.string_before tout ( ( String.length tout ) - 2 )

   end in

   Array.map f c ;;




(** 
xpm_colors_substitution string_array
 *)


let xpm_colors_substitution = function (v:string array) ->

 let symbols = xpm_colors_symbols v

 and values = xpm_colors_values v in

  let l = Array.length symbols in

   function (y:string) ->

    begin

     let z = ref y

     and i = ref 0 in

      while !i < l do

       let expression = symbols.(!i) in

        if string_match expression !z 0 then

         begin

          z := Str.global_substitute expression ( function x -> values.(!i) ) y ;

          i := l

         end

        else i := succ !i

     done ;

     !z

    end ;;




(** 
pixels_line_splitting string_array
 *)


let pixels_line_splitting = fun (n:int) (c:int) (x:string) ->

 if ( String.length x ) < 2 + n * c then failwith "Bad sizes in Readwrite.pixels_line_splitting" ;

 let v = Array.make n "" in

  for i = 0 to pred n do

   let ii = 1 + i * c in

    v.(i) <- String.sub x ii c

  done ;

  v ;;




(** 
xpm_pixels_strings string_array
 *)


let xpm_pixels_strings = function (v:string array) ->

 let l = xpm_pixels_end v

 and sizes = xpm_sizes v

 and j = xpm_pixels_index v in


(** Eliminate the trailing lines. *)


  let vv = Array.sub v ( succ j ) ( l - j - 1 )

  and c = sizes.(3)

  and w = sizes.(0) in

   let f = pixels_line_splitting w c in

    Array.map f vv ;;




(** 
xpm_pixels_values string_array
 *)


let xpm_pixels_values = function (v:string array) ->

 let p = xpm_pixels_strings v in

  let lines = pred ( Array.length p ) in

   let replace = xpm_colors_substitution v in

    for j = 0 to lines do

     p.(j) <- Array.map replace p.(j) ;

    done ;

    p ;;




(** 
xpm_int_red string_array
 *)


let xpm_int_red = function (v:string array) ->

 let vv = xpm_pixels_values v in

  Array.map ( Array.map string_to_int_red ) vv ;;




(** 
xpm_int_green string_array
 *)


let xpm_int_green = function (v:string array) ->

 let vv = xpm_pixels_values v in

  Array.map ( Array.map string_to_int_green ) vv ;;




(** 
xpm_int_blue string_array
 *)


let xpm_int_blue = function (v:string array) ->

 let vv = xpm_pixels_values v in

  Array.map ( Array.map string_to_int_blue ) vv ;;




(** 
xpm_int_luminance string_array
 *)


let xpm_int_luminance = function (v:string array) ->

 let vv = xpm_pixels_values v in

  Array.map ( Array.map string_to_int_luminance ) vv ;;




(** 
xpm_int_rgb string_array
 *)


let xpm_int_rgb = function (v:string array) ->

 let vv = xpm_pixels_values v in

  let l = Array.length vv

  and w = Array.length vv.(0) in

   let red = Array.make_matrix l w 0

   and green = Array.make_matrix l w 0

   and blue = Array.make_matrix l w 0

   and ww = pred w in

    for i = 0 to pred l do

     let red_output = red.(i)

     and green_output = green.(i)

     and blue_output = blue.(i)

     and row_input = vv.(i) in

       for j = 0 to ww do

        let x = string_to_int_rgb row_input.(j) in

         red_output.(j) <- x.(0) ;

         green_output.(j) <- x.(1) ;

         blue_output.(j) <- x.(2) ;

       done

     done ;

     [| red ; green ; blue |] ;;




(** 
xpm_float_red string_array
 *)


let xpm_float_red = function (v:string array) ->

 let vv = xpm_pixels_values v in

  Array.map ( Array.map string_to_float_red ) vv ;;




(** 
xpm_float_green string_array
 *)


let xpm_float_green = function (v:string array) ->

 let vv = xpm_pixels_values v in

  Array.map ( Array.map string_to_float_green ) vv ;;




(** 
xpm_float_blue string_array
 *)


let xpm_float_blue = function (v:string array) ->

 let vv = xpm_pixels_values v in

  Array.map ( Array.map string_to_float_blue ) vv ;;




(** 
xpm_float_luminance string_array
 *)


let xpm_float_luminance = function (v:string array) ->

 let vv = xpm_pixels_values v in

  Array.map ( Array.map string_to_float_luminance ) vv ;;




(** 
xpm_float_rgb string_array
 *)


let xpm_float_rgb = function (v:string array) ->

 let vv = xpm_pixels_values v in

  let l = Array.length vv

  and w = Array.length vv.(0) in

   let red = Array.make_matrix l w 0.

   and green = Array.make_matrix l w 0.

   and blue = Array.make_matrix l w 0.

   and ww = pred w in

    for i = 0 to pred l do

     let red_output = red.(i)

     and green_output = green.(i)

     and blue_output = blue.(i)

     and row_input = vv.(i) in

       for j = 0 to ww do

        let x = string_to_float_rgb row_input.(j) in

         red_output.(j) <- x.(0) ;

         green_output.(j) <- x.(1) ;

         blue_output.(j) <- x.(2) ;

       done

     done ;

     [| red ; green ; blue |] ;;




(** 
xpm_color_array string_array
 *)


let xpm_color_array = function (v:string array) ->

 let vv = xpm_pixels_values v in

  let l = Array.length vv

  and w = Array.length vv.(0) in

   let p = Array.make_matrix l w 0

   and ww = pred w in

    for i = 0 to pred l do

     let row_output = p.(i)

     and row_input = vv.(i) in

       for j = 0 to ww do

         row_output.(j) <- string_to_color row_input.(j)

       done

     done ;

     p ;;










(** 
§ 
 *)



(** 

Fichiers d'images pnm : pgm et ppm


Pnm picture files: pgm and ppm

*)



(** 
 
 *)











(** The PNM files split into three classes: PBM with one bit per pixel,
PGM with grey levels, PPM with three primary colors. They may be saved in text files
or in consecutive bytes.



Les fichiers PNM se décomposent en trois classes : PBM à un bit par pixel, 
PGM en niveaux de gris, PPM en trichromie. Ils peuvent être stockés en fichiers textes
ou en octets consécutifs. *)







(** 
read_pnm_header filename
 *)


let read_pnm_header = function (s:string) ->

 let a = ref ( array_read_text_header 3 s )

 and i = ref 1 in

  while !a.(!i).[0] = '#' do

   a := array_read_text_header ( !i + 3 ) s ;

   incr i

  done ;

  !a ;;






(** 
ppm_header_of_rgb rgb_matrix
 *)


let ppm_header_of_rgb = function m ->

 let l = Array.length m.(0)

 and c = Array.length m.(0).(0) in

  [| "P6" ; ( string_of_int c ) ^ " " ^ ( string_of_int l ) ; "255" |] ;;




(** 
pgm_header_of_unicolor matrix
 *)


let pgm_header_of_unicolor = function m ->

 let l = Array.length m

 and c = Array.length m.(0) in

  [| "P5" ; ( string_of_int c ) ^ " " ^ ( string_of_int l ) ; "255" |] ;;






(** 
read_pbm_binary_int_gray filename
 *)


let read_pbm_binary_int_gray = function (s:string) ->

 let e = read_pnm_header s

 and maximum = 255

 and dot = String.make 1 ( char_of_int 10 ) in

  if e.(0).[1] != '4' then failwith "Not a pbm_binary file in Readwrite.read_pbm_binary_int_gray." ;

  let l = Array.length e in

   let one = l - 2

   and sharp = ( if l = 3 then "" else Array.fold_left ( fun x y -> x ^ dot ^ y ) "" ( Array.sub e 1 ( l - 3 ) ) ) in

    let size = e.(one)

    and r = Str.regexp_string " " in

     let dim = Array.of_list ( Str.split r size ) in

      let c = int_of_string dim.(0)

      and l = int_of_string dim.(1) in

       let chaine = e.(0) ^ dot ^ e.(one) ^ dot ^ sharp

       and taille = l * c / 8 in

        let offset = String.length chaine in

         let v = array_read_binary_file ( offset + taille ) s in

          let vv = Array.sub v offset taille

          and cc = pred c

          and result = Array.make_matrix l c 0 in

           for i = 0 to pred l do

            let row = result.(i)

            and ii = i * c in

             for j = 0 to cc do

              let jj = ii + j in

               row.(j) <- ( 1 - ( ( vv.( jj / 8 ) lsr ( 7 - ( jj mod 8 ) ) ) mod 2 ) ) * maximum

             done

           done ;

           result ;;




(** 
read_pbm_binary_int_unicolor filename
 *)


let read_pbm_binary_int_unicolor = function (s:string) ->

 read_pbm_binary_int_gray s ;;




(** 
read_pbm_binary_int_rbg filename
 *)


let read_pbm_binary_int_rbg = function (s:string) ->

 let r = read_pbm_binary_int_gray s in

  let g = Matrix.matrix_int_copy r

  and b = Matrix.matrix_int_copy r in

   [| r ; g ; b |]






(** 
read_pbm_binary_color filename
 *)


let read_pbm_binary_color = function (s:string) ->

 Array.map ( Array.map ( ( * ) 65793 ) ) ( read_pbm_binary_int_gray s ) ;;






(** 
read_pbm_binary_float_gray filename
 *)


let read_pbm_binary_float_gray = function (s:string) ->

 Array.map ( Array.map float ) ( read_pbm_binary_int_gray s ) ;;




(** 
read_pbm_binary_float_unicolor filename
 *)


let read_pbm_binary_float_unicolor = function (s:string) ->

 read_pbm_binary_float_gray s ;;




(** 
read_pbm_binary_float_rgb filename
 *)


let read_pbm_binary_float_rgb = function (s:string) ->

 let r = read_pbm_binary_float_gray s in

  let g = Matrix.matrix_float_copy r

  and b = Matrix.matrix_float_copy r in

   [| r ; g ; b |]








(** 
read_pgm_binary_int_gray filename
 *)


let read_pgm_binary_int_gray = function (s:string) ->

 let e = read_pnm_header s

 and dot = String.make 1 ( char_of_int 10 ) in

  if e.(0).[1] != '5' then failwith "Not a pgm_binary file in Readwrite.read_pgm_binary_int_gray." ;

  let l = Array.length e in

   let one = l - 2

   and two = l - 1

   and sharp = ( if l = 3 then "" else Array.fold_left ( fun x y -> x ^ dot ^ y ) "" ( Array.sub e 1 ( l - 3 ) ) ) in

    let size = e.(one)

    and depth = e.(two)

    and r = Str.regexp_string " " in

     let dim = Array.of_list ( Str.split r size )

     and atom = int_of_string depth in

      if atom != 255 then failwith "Only gray files with depth 255 are taken in account in Readwrite.read_pgm_binary_int_gray." ;

      let c = int_of_string dim.(0)

      and l = int_of_string dim.(1) in

       let chaine = e.(0) ^ dot ^ e.(one) ^ dot ^ e.(two) ^ dot ^ sharp in

        let offset = String.length chaine in

         let v = array_read_binary_file ( offset + l * c ) s in

          Util.vector_to_matrix l c ( Array.sub v offset ( l * c ) ) ;;




(** 
read_pgm_binary_int_unicolor filename
 *)


let read_pgm_binary_int_unicolor = function (s:string) ->

 read_pgm_binary_int_gray s ;;




(** 
read_pgm_binary_int_rbg filename
 *)


let read_pgm_binary_int_rbg = function (s:string) ->

 let r = read_pgm_binary_int_gray s in

  let g = Matrix.matrix_int_copy r

  and b = Matrix.matrix_int_copy r in

   [| r ; g ; b |]




(** 
write_pgm_binary_int_unicolor matrix filename
 *)


let write_pgm_binary_int_unicolor = fun (m:int array array) (fname:string) ->

 let oc = open_out fname

 and l = Array.length m

 and c = Array.length m.(0) in

  output_string oc ( "P5\n" ^ ( string_of_int c ) ^ " " ^ ( string_of_int l ) ^ "\n255\n" ) ;

  set_binary_mode_out oc true ;

  let cc = pred c in

   for i = 0 to pred l do

    let row = m.(i) in

     for j = 0 to cc do

      output_byte oc row.(j)

     done ;

   done ;

   close_out_noerr oc ;;






(** 
read_pgm_binary_color filename
 *)


let read_pgm_binary_color = function (s:string) ->

 Array.map ( Array.map ( ( * ) 65793 ) ) ( read_pgm_binary_int_gray s ) ;;






(** 
read_pgm_binary_float_gray filename
 *)


let read_pgm_binary_float_gray = function (s:string) ->

 Array.map ( Array.map float ) ( read_pgm_binary_int_gray s ) ;;




(** 
read_pgm_binary_float_unicolor filename
 *)


let read_pgm_binary_float_unicolor = function (s:string) ->

 read_pgm_binary_float_gray s ;;




(** 
read_pgm_binary_float_rgb filename
 *)


let read_pgm_binary_float_rgb = function (s:string) ->

 let r = read_pgm_binary_float_gray s in

  let g = Matrix.matrix_float_copy r

  and b = Matrix.matrix_float_copy r in

   [| r ; g ; b |]






(** 
write_pgm_binary_float_unicolor matrix filename
 *)


let write_pgm_binary_float_unicolor = fun (m:float array array) (fname:string) ->

 let oc = open_out fname

 and l = Array.length m

 and c = Array.length m.(0) in

  output_string oc ( "P5\n" ^ ( string_of_int c ) ^ " " ^ ( string_of_int l ) ^ "\n255\n" ) ;

  set_binary_mode_out oc true ;

  let cc = pred c in

   for i = 0 to pred l do

    let row = m.(i) in

     for j = 0 to cc do

      output_byte oc ( min 255 ( Util.round row.(j) ) )

     done ;

   done ;

   close_out_noerr oc ;;








(** 
read_ppm_binary_int_rgb filename
 *)


let read_ppm_binary_int_rgb = function (s:string) ->

 let e = read_pnm_header s

 and dot = String.make 1 ( char_of_int 10 ) in

  if e.(0).[1] != '6' then failwith "Not a ppm_binary file in Readwrite.read_ppm_binary_int_rgb." ;

  let l = Array.length e in

   let one = l - 2

   and two = l - 1

   and sharp = ( if l = 3 then "" else Array.fold_left ( fun x y -> x ^ dot ^ y ) "" ( Array.sub e 1 ( l - 3 ) ) ) in

    let size = e.(one)

    and depth = e.(two)

    and r = Str.regexp_string " " in

     let dim = Array.of_list ( Str.split r size )

     and atom = int_of_string depth in

      if atom != 255 then failwith "Only color files with depth 255 are taken in account in Readwrite.read_ppm_binary_int_rgb." ;

      let c = int_of_string dim.(0)

      and l = int_of_string dim.(1)

      and dot = String.make 1 ( char_of_int 10 ) in

       let chaine = e.(0) ^ dot ^ e.(one) ^ dot ^ e.(two) ^ dot ^ sharp

       and taille = 3 * l * c in

        let offset = String.length chaine in

         let v = array_read_binary_file ( offset + taille ) s in

          let vv = Array.sub v offset taille in

           Array.map ( Util.vector_to_matrix l c ) ( Util.vector_spray 3 vv ) ;;




(** 
read_ppm_binary_int_red filename
 *)


let read_ppm_binary_int_red = function (s:string) ->

 ( read_ppm_binary_int_rgb s ).(0) ;;




(** 
read_ppm_binary_int_green filename
 *)


let read_ppm_binary_int_green = function (s:string) ->

 ( read_ppm_binary_int_rgb s ).(1) ;;




(** 
read_ppm_binary_int_blue filename
 *)


let read_ppm_binary_int_blue = function (s:string) ->

 ( read_ppm_binary_int_rgb s ).(2) ;;






(** 
write_ppm_binary_int_rgb rgb_matrix filename
 *)


let write_ppm_binary_int_rgb = fun (m:int array array array) (fname:string) ->

 let oc = open_out fname

 and red = m.(0)

 and green = m.(1)

 and blue = m.(2) in

  let l = Array.length blue

  and c = Array.length blue.(0) in

   output_string oc ( "P6\n" ^ ( string_of_int c ) ^ " " ^ ( string_of_int l ) ^ "\n255\n" ) ;

   set_binary_mode_out oc true ;

   let cc = pred c in

    for i = 0 to pred l do

     let row_red = red.(i)

     and row_green = green.(i)

     and row_blue = blue.(i) in

      for j = 0 to cc do

       output_byte oc row_red.(j) ;

       output_byte oc row_green.(j) ;

       output_byte oc row_blue.(j) ;

      done ;

    done ;

    close_out_noerr oc ;;






(** 
read_ppm_binary_color filename
 *)


let read_ppm_binary_color = function (s:string) ->

 let e = read_pnm_header s

 and dot = String.make 1 ( char_of_int 10 ) in

  if e.(0).[1] != '6' then failwith "Not a ppm_binary file in Readwrite.read_ppm_binary_color." ;

  let l = Array.length e in

   let one = l - 2

   and two = l - 1

   and sharp = ( if l = 3 then "" else Array.fold_left ( fun x y -> x ^ dot ^ y ) "" ( Array.sub e 1 ( l - 3 ) ) ) in

    let size = e.(one)

    and depth = e.(two)

    and r = Str.regexp_string " " in

     let dim = Array.of_list ( Str.split r size )

     and atom = int_of_string depth in

      if atom != 255 then failwith "Only color files with depth 255 are taken in account in Readwrite.read_ppm_binary_color." ;

      let c = int_of_string dim.(0)

      and l = int_of_string dim.(1) in

       let chaine = e.(0) ^ dot ^ e.(one) ^ dot ^ e.(two) ^ dot ^ sharp

       and length = l * c in

        let offset = String.length chaine

        and taille = 3 * length in

         let v = array_read_binary_file ( offset + taille ) s in

          let vv = Array.sub v offset taille

          and vvv = Array.make length 0 in

           for i = 0 to pred length do

            let ii = 3 * i in

             vvv.(i) <- ( ( 256 * vv.(ii) ) + vv.( ii + 1 ) ) * 256 + vv.( ii + 2 )

           done ;

           Util.vector_to_matrix l c vvv ;;






(** 
write_ppm_binary_color matrix filename
 *)


let write_ppm_binary_color = fun (m:int array array) (fname:string) ->

 let oc = open_out fname

 and l = Array.length m

 and c = Array.length m.(0) in

  output_string oc ( "P6\n" ^ ( string_of_int c ) ^ " " ^ ( string_of_int l ) ^ "\n255\n" ) ;

  set_binary_mode_out oc true ;

  let cc = pred c in

   for i = 0 to pred l do

    let row = m.(i) in

     for j = 0 to cc do

      let x = row.(j) in

       let xx = x / 256 in

        output_byte oc ( xx / 256 ) ;

        output_byte oc ( xx mod 256 ) ;

        output_byte oc ( x mod 256 ) ;

      done ;

    done ;

    close_out_noerr oc ;;






(** 
read_ppm_binary_float_rgb filename
 *)


let read_ppm_binary_float_rgb = function (s:string) ->

 let e = read_pnm_header s

 and dot = String.make 1 ( char_of_int 10 ) in

  if e.(0).[1] != '6' then failwith "Not a ppm_binary file in Readwrite.read_ppm_binary_float_rgb." ;

  let l = Array.length e in

   let one = l - 2

   and two = l - 1

   and sharp = ( if l = 3 then "" else Array.fold_left ( fun x y -> x ^ dot ^ y ) "" ( Array.sub e 1 ( l - 3 ) ) ) in

    let size = e.(one)

    and depth = e.(two)

    and r = Str.regexp_string " " in

     let dim = Array.of_list ( Str.split r size )

     and atom = int_of_string depth in

      if atom != 255 then failwith "Only color files with depth 255 are taken in account in Readwrite.read_ppm_binary_float_rgb." ;

      let c = int_of_string dim.(0)

      and l = int_of_string dim.(1)

      and dot = String.make 1 ( char_of_int 10 ) in

       let chaine = e.(0) ^ dot ^ e.(one) ^ dot ^ e.(two) ^ dot ^ sharp in

        let offset = String.length chaine

        and taille = 3 * l * c in

         let v = array_read_binary_file ( offset + taille ) s in

          let vv = Array.map float ( Array.sub v offset taille ) in

           Array.map ( Util.vector_to_matrix l c ) ( Util.vector_spray 3 vv ) ;;




(** 
read_ppm_binary_float_red filename
 *)


let read_ppm_binary_float_red = function (s:string) ->

 ( read_ppm_binary_float_rgb s ).(0) ;;




(** 
read_ppm_binary_float_green filename
 *)


let read_ppm_binary_float_green = function (s:string) ->

 ( read_ppm_binary_float_rgb s ).(1) ;;




(** 
read_ppm_binary_float_blue filename
 *)


let read_ppm_binary_float_blue = function (s:string) ->

 ( read_ppm_binary_float_rgb s ).(2) ;;






(** 
write_ppm_binary_float_rgb rgb_matrix filename
 *)


let write_ppm_binary_float_rgb = fun (m:float array array array) (fname:string) ->

 let oc = open_out fname

 and red = m.(0)

 and green = m.(1)

 and blue = m.(2) in

  let l = Array.length blue

  and c = Array.length blue.(0) in

   output_string oc ( "P6\n" ^ ( string_of_int c ) ^ " " ^ ( string_of_int l ) ^ "\n255\n" ) ;

   set_binary_mode_out oc true ;

   let cc = pred c in

    for i = 0 to pred l do

     let row_red = red.(i)

     and row_green = green.(i)

     and row_blue = blue.(i) in

      for j = 0 to cc do

       output_byte oc (  min 255 ( Util.round row_red.(j) ) ) ;

       output_byte oc ( min 255 ( Util.round row_green.(j) ) ) ;

       output_byte oc ( min 255 ( Util.round row_blue.(j) ) ) ;

      done ;

    done ;

    close_out_noerr oc ;;






(** 
read_ppm_binary_under_sample_float_rgb edge filename
 *)


let read_ppm_binary_under_sample_float_rgb = fun (n:int) (fname:string) ->

 matrix_float_rgb_under_sample n ( read_ppm_binary_float_rgb fname ) ;;




(** 
read_ppm_binary_under_sample_float_red edge filename
 *)


let read_ppm_binary_under_sample_float_red = fun (n:int) (fname:string) ->

 matrix_float_unicolor_under_sample n ( read_ppm_binary_float_red fname ) ;;




(** 
read_ppm_binary_under_sample_float_green edge filename
 *)


let read_ppm_binary_under_sample_float_green = fun (n:int) (fname:string) ->

 matrix_float_unicolor_under_sample n ( read_ppm_binary_float_green fname ) ;;




(** 
read_ppm_binary_under_sample_float_blue edge filename
 *)


let read_ppm_binary_under_sample_float_blue = fun (n:int) (fname:string) ->

 matrix_float_unicolor_under_sample n ( read_ppm_binary_float_blue fname ) ;;






(** 
read_ppm_binary_under_sample_color edge filename
 *)


let read_ppm_binary_under_sample_color = fun (n:int) (fname:string) ->

 matrix_float_rgb_to_color ( read_ppm_binary_under_sample_float_rgb n fname ) ;;






(** 
read_ppm_binary_under_sample_int_rgb edge filename
 *)


let read_ppm_binary_under_sample_int_rgb = fun (n:int) (fname:string) ->

 matrix_float_rgb_to_int_rgb ( read_ppm_binary_under_sample_float_rgb n fname ) ;;




(** 
read_ppm_binary_under_sample_int_red edge filename
 *)


let read_ppm_binary_under_sample_int_red = fun (n:int) (fname:string) ->

 Matrix.matrix_int_clip 255 ( Matrix.matrix_float_round ( read_ppm_binary_under_sample_float_red n fname ) ) ;;




(** 
read_ppm_binary_under_sample_int_green edge filename
 *)


let read_ppm_binary_under_sample_int_green = fun (n:int) (fname:string) ->

 Matrix.matrix_int_clip 255 ( Matrix.matrix_float_round ( read_ppm_binary_under_sample_float_green n fname ) ) ;;




(** 
read_ppm_binary_under_sample_int_blue edge filename
 *)


let read_ppm_binary_under_sample_int_blue = fun (n:int) (fname:string) ->

 Matrix.matrix_int_clip 255 ( Matrix.matrix_float_round ( read_ppm_binary_under_sample_float_blue n fname ) ) ;;










(** 
§ 
 *)



(** 

Fichiers d'images bitmap


Bitmap picture files

*)



(** 
 
 *)











(** A description of the bmp format is available in the numbers 62 and 100 of the magazine LOGIN: pages 64-67.



Une description du format bmp est disponible dans les numéros 62 et 100 du magazine LOGIN: pages 64-67. *)







(** 
f32 offset array
 *)


let f32 = fun (i:int) (x:int array) ->

 string_of_int ( x.(i) + 256 * ( x.( i + 1 ) + 256 * ( x.( i + 2 ) + 256 * x.( i + 3 ) ) ) )




(** 
f16 offset array
 *)


let f16 = fun (i:int) (x:int array) ->

 string_of_int ( x.(i) + 256 * ( x.( i + 1 ) ) )




(** 
g16 integer
 *)


let g16 = function (x:int) ->

 [| x mod 256 ; x / 256 |]




(** 
g32 integer
 *)


let g32 = function (x:int) ->

 let xx = x mod 256 in

 let y = x / 256 in

  let yy = y mod 256

  and z = y / 256 in

   let zz = z mod 256 in

 [| xx ; yy ; zz ; x / 16777216 |]




(** 
read_bmp_header filename
 *)


let read_bmp_header = function (fname:string) ->

 let ic = open_in fname

 and a = ref [] in

  begin

   try

    begin

     for i = 0 to 53 do

      a := ( input_byte ic ) :: !a

     done ;

     close_in_noerr ic ;

    end

   with _ ->

    close_in_noerr ic

  end ;

  let b = Array.of_list ( List.rev !a ) in

   if ( char_of_int b.(0) <> 'B' ) || ( char_of_int b.(1) <> 'M' ) then

    failwith "Bad magic number in Readwrite.read_bmp_header." ;

   let c = Array.make 16 "BM" in

    c.(1) <- f32 2 b ;

    c.(2) <- f16 6 b ;

    c.(3) <- f16 8 b ;

    c.(4) <- f32 10 b ;

    c.(5) <- f32 14 b ;

    c.(6) <- f32 18 b ;

    c.(7) <- f32 22 b ;

    c.(8) <- f16 26 b ;

    c.(9) <- f16 28 b ;

    c.(10) <- f32 30 b ;

    c.(11) <- f32 34 b ;

    c.(12) <- f32 38 b ;

    c.(13) <- f32 42 b ;

    c.(14) <- f32 46 b ;

    c.(15) <- f32 50 b ;

    c ;;






(** 
read_raw_bmp_int_rgb filename
 *)


let read_raw_bmp_int_rgb = function (fname:string) ->

 try

  begin

   let h = read_bmp_header fname

   and offset = 54 in

    if int_of_string h.(10) <> 0 then

     failwith "Compressed format in Readwrite.read_raw_bmp_int_rgb." ;

    if int_of_string h.(9) <> 24 then

     failwith "Number of bits per pixel not programmed in Readwrite.read_raw_bmp_int_rgb." ;

    let width = int_of_string h.(6)

    and height = int_of_string h.(7) in

     let ww = pred width

     and hh = pred height

     and tw = 3 * width

     and r = Array.make_matrix height width 0

     and g = Array.make_matrix height width 0

     and b = Array.make_matrix height width 0

     and a = ref ( array_read_binary_file ( width * height + offset ) fname ) in

      a := Util.array_end offset !a ;

      for i = 0 to hh do

       let ii = ( hh - i ) * tw

       and red_output = r.(i)

       and green_output = g.(i)

       and blue_output = b.(i) in

        for j = 0 to ww do

         let jj = 3 * j in

          blue_output.(j) <- !a.( ii + jj ) ;

          green_output.(j) <- !a.( ii + jj + 1 ) ;

          red_output.(j) <- !a.( ii + jj + 2 ) ;

        done

      done ;

      [| r ; g ; b |]

  end

 with _ ->

  failwith "Error in Readwrite.read_raw_bmp_int_rgb." ;;




(** 
read_raw_bmp_red filename
 *)


let read_raw_bmp_red = function (fname:string) ->

 try

  ( read_raw_bmp_int_rgb fname ).(0)

 with _ ->

  failwith "Error in Readwrite.read_raw_bmp_red." ;;




(** 
read_raw_bmp_green filename
 *)


let read_raw_bmp_green = function (fname:string) ->

 try

  ( read_raw_bmp_int_rgb fname ).(1)

 with _ ->

  failwith "Error in Readwrite.read_raw_bmp_red." ;;




(** 
read_raw_bmp_blue filename
 *)


let read_raw_bmp_blue = function (fname:string) ->

 try

  ( read_raw_bmp_int_rgb fname ).(2)

 with _ ->

  failwith "Error in Readwrite.read_raw_bmp_blue." ;;




(** 
read_raw_bmp_color filename
 *)


let read_raw_bmp_color = function (fname:string) ->

 try

  matrix_int_rgb_to_color ( read_raw_bmp_int_rgb fname )

 with _ ->

  failwith "Error in Readwrite.read_raw_bmp_color." ;;






(** 
read_palette_bmp_int_rgb filename
 *)


let read_palette_bmp_int_rgb = function (fname:string) ->

 try

  begin

   let h = read_bmp_header fname

   and decalage = 54 in

    if int_of_string h.(10) <> 0 then

     failwith "Compressed format in Readwrite.read_palette_bmp_int_rgb." ;

    if int_of_string h.(9) <> 8 then

     failwith "Number of bits per pixel not programmed in Readwrite.read_palette_bmp_int_rgb." ;

    let size = int_of_string h.(11)

    and file_size = int_of_string h.(1)

    and height = int_of_string h.(7) in


(** Errors in the declaration of the number of columns are possible.



Des erreurs sur la déclaration du nombre de colonnes sont possibles. *)


     let width = max ( int_of_string h.(6) ) ( size / height )


(** The offset after the header is not always equal to 1024=256*4.



Le décalage après l'entête ne vaut pas toujours 1024=256*4. *)


     and offset = ( min ( int_of_string h.(4) ) ( file_size - size ) ) - 54

     and a = ref ( array_read_binary_file ( file_size ) fname ) in

      a := Util.array_end decalage !a ;

      let ww = pred width

      and hh = pred height


(** The format of the palette is bb gg rr 00 with four bytes per color.



Le format de la palette est bb gg rr 00 avec quatre octets par couleur. *)


      and palette =  Array.sub !a 0 offset

      and r = Array.make_matrix height width 0

      and g = Array.make_matrix height width 0

      and b = Array.make_matrix height width 0 in

       a := Util.array_end offset !a ;

       for i = 0 to hh do

        let red_output = r.(i)

        and green_output = g.(i)

        and blue_output = b.(i)

        and ii = ( hh - i ) * width in

         for j = 0 to ww do

          let color = 4 * !a.( ii + j ) in

           let code = Array.sub palette color 4 in

            blue_output.(j) <- code.(0) ;

            green_output.(j) <- code.(1) ;

            red_output.(j) <- code.(2) ;

         done

       done ;

       [| r ; g ; b |]

  end

 with _ ->

  failwith "Error in Readwrite.read_palette_bmp_int_rgb." ;;




(** 
read_palette_bmp_red filename
 *)


let read_palette_bmp_red = function (fname:string) ->

 try

  ( read_palette_bmp_int_rgb fname ).(0)

 with _ ->

  failwith "Error in Readwrite.read_palette_bmp_red." ;;




(** 
read_palette_bmp_green filename
 *)


let read_palette_bmp_green = function (fname:string) ->

 try

  ( read_palette_bmp_int_rgb fname ).(1)

 with _ ->

  failwith "Error in Readwrite.read_palette_bmp_red." ;;




(** 
read_palette_bmp_blue filename
 *)


let read_palette_bmp_blue = function (fname:string) ->

 try

  ( read_palette_bmp_int_rgb fname ).(2)

 with _ ->

  failwith "Error in Readwrite.read_palette_bmp_blue." ;;




(** 
read_palette_bmp_color filename
 *)


let read_palette_bmp_color = function (fname:string) ->

 try

  matrix_int_rgb_to_color ( read_palette_bmp_int_rgb fname )

 with _ ->

  failwith "Error in Readwrite.read_palette_bmp_color." ;;






(** 
read_bmp_int_rgb filename
 *)


let read_bmp_int_rgb = function (fname:string) ->

 try

  begin

   try

    read_raw_bmp_int_rgb fname

   with _ ->

    read_palette_bmp_int_rgb fname

  end

 with _ ->

  failwith "Fomat not programmed in Readwrite.read_bmp_int_rgb." ;;




(** 
read_bmp_red filename
 *)


let read_bmp_red = function (fname:string) ->

 try

  ( read_bmp_int_rgb fname ).(0)

 with _ ->

  failwith "Fomat not programmed in Readwrite.read_bmp_red." ;;




(** 
read_bmp_green filename
 *)


let read_bmp_green = function (fname:string) ->

 try

  ( read_bmp_int_rgb fname ).(1)

 with _ ->

  failwith "Fomat not programmed in Readwrite.read_bmp_green." ;;




(** 
read_bmp_blue filename
 *)


let read_bmp_blue = function (fname:string) ->

 try

  ( read_bmp_int_rgb fname ).(2)

 with _ ->

  failwith "Fomat not programmed in Readwrite.read_bmp_blue." ;;




(** 
read_bmp_color filename
 *)


let read_bmp_color = function (fname:string) ->

 try

  matrix_int_rgb_to_color ( read_bmp_int_rgb fname )

 with _ ->

  failwith "Fomat not programmed in Readwrite.read_bmp_color." ;;






(** 
bmp_header_of_rgb rgb_matrix
 *)


let bmp_header_of_rgb = function (m:int array array array) ->

 let h = Array.length m.(0)

 and w = Array.length m.(0).(0) in

  let size = 3 * h * w in

   let file_size = 54 + size in

    Array.concat [ [| int_of_char 'B' ; int_of_char 'M' ; |] ; g32 file_size ; g16 0 ; g16 0 ; g32 54 ; g32 40 ; g32 w ; g32 h ; g16 1 ; g16 24 ; g32 0 ; g32 size ; g32 3780 ; g32 3780 ; g32 0 ; g32 0 ] ;;




(** 
write_bmp_int_rgb rgb_matrix
 *)


let write_bmp_int_rgb = fun (m:int array array array) (fname:string) ->

 let oc = open_out fname

 and a = bmp_header_of_rgb m

 and red = m.(0)

 and green = m.(1)

 and blue = m.(2) in

  set_binary_mode_out oc true ;

  for i = 0 to pred ( Array.length a ) do

   output_byte oc a.(i)

  done ;

  let hh = pred ( Array.length red )

   and ww = pred ( Array.length red.(0) ) in

    for i = hh downto 0 do

     let row_red = red.(i)

     and row_green = green.(i)

     and row_blue = blue.(i) in

      for j = 0 to ww do

       output_byte oc row_blue.(j) ;

       output_byte oc row_green.(j) ;

       output_byte oc row_red.(j) ;

      done ;

    done ;

    close_out_noerr oc ;;




(** 
write_bmp_color rgb_matrix
 *)


let write_bmp_color = fun (m:int array array) (fname:string) ->

 let mm = matrix_color_to_int_rgb m in

  write_bmp_int_rgb mm fname ;;




(** 
write_bmp_float_rgb rgb_matrix
 *)


let write_bmp_float_rgb = fun (m:float array array array) (fname:string) ->

 let mm = matrix_float_rgb_to_int_rgb m in

  write_bmp_int_rgb mm fname ;;










(** 
§ 
 *)



(** 

Fichiers sons au


Au sound files

*)



(** 
 
 *)











(** 
read_header_au
 This function is only for 64 bits platforms. The output has the following form:



[| magic_type ; offset ; size ; encoding ; sample_rate ; channels |]



La sortie a la forme précédente.
Cette fonction est réservée aux plateformes 64 bits. *)


let read_header_au = function (fname:string) ->

 let ic = open_in_bin fname

 and v = Array.make 6 0

 and type_snd = Int32.to_int ( Int32.of_string "0x2e736e64" ) in

  begin

   try


(** magic_type *)


    v.(0) <- input_binary_int ic ;

    if compare type_snd v.(0) != 0 then failwith "Not a valid file in Readwrite.read_header_au." ;


(** offset *)


    v.(1) <- input_binary_int ic ;


(** size *)


    v.(2) <- input_binary_int ic ;


(** encoding *)


    v.(3) <- input_binary_int ic ;


(** sample_rate *)


    v.(4) <- input_binary_int ic ;


(** channels *)


    v.(5) <- input_binary_int ic ;

    close_in_noerr ic ;

   with End_of_file -> ( close_in_noerr ic ; failwith "Not a valid header in Readwrite.read_header_au." )

  end ;

  v ;;






(** 
read_float32_au
 This function is only for 64 bits platforms.



Cette fonction est réservée aux plateformes 64 bits. *)


let read_float32_au = function (fname:string) ->

 let h = read_header_au fname

 and ic = open_in_bin fname in

  if compare h.(3) 6 != 0 then failwith "Bad encoding in Readwrite.read_float32_au." ;

  begin

   try seek_in ic h.(1) with End_of_file -> failwith "Bad offset in Readwrite.read_float32_au."

  end ;

  let l = ref []

  and channels = h.(5)

  and count = ref 0 in

  begin

   try

    while true do

     l := ( input_binary_int ic ) :: !l ;

     count := succ !count ;

    done

   with End_of_file -> close_in_noerr ic

  end ;

  let samples = !count / channels in

   let m = Array.make_matrix channels samples 0.

   and c = pred channels in

    for i = pred samples downto 0 do

     for j = c downto 0 do

      m.(j).(i) <- Int32.float_of_bits ( Int32.of_int ( List.hd !l ) ) ;

      l := List.tl !l

     done ;

    done ;

    m ;;






(** 
write_vector_float_to_float32_au
 This function is only for 64 bits platforms.



Cette fonction est réservée aux plateformes 64 bits. *)


let write_vector_float_to_float32_au = fun (sample_rate:int) (v:float array) (fname:string) ->

 let oc = open_out fname

 and offset = 24

 and size = - 1

 and encoding = 6

 and channels = 1

 and l = pred ( Array.length v ) in

  output_string oc ".snd" ;

  set_binary_mode_out oc true ;

  output_binary_int oc offset ;

  output_binary_int oc size ;

  output_binary_int oc encoding ;

  output_binary_int oc sample_rate ;

  output_binary_int oc channels ;

  for i = 0 to l do

   let x = Int32.to_int ( Int32.bits_of_float v.(i) ) in

    output_binary_int oc x ;

  done ;

  close_out_noerr oc ;;






(** 
write_matrix_float_to_float32_au
 This function is only for 64 bits platforms.



Cette fonction est réservée aux plateformes 64 bits. *)


let write_matrix_float_to_float32_au = fun (sample_rate:int) (m:float array array) (fname:string) ->

 let oc = open_out fname

 and offset = 24

 and size = - 1

 and encoding = 6

 and channels = Array.length m

 and samples = Array.length m.(0) in

  output_string oc ".snd" ;

  set_binary_mode_out oc true ;

  output_binary_int oc offset ;

  output_binary_int oc size ;

  output_binary_int oc encoding ;

  output_binary_int oc sample_rate ;

  output_binary_int oc channels ;

   let c = pred channels in

    for i = 0 to pred samples do

     for j = 0 to c do

      let x = Int32.to_int ( Int32.bits_of_float m.(j).(i) ) in

       output_binary_int oc x ;

     done ;

    done ;

  close_out_noerr oc ;;






(** 
read_vector_float64_au
 *)


let read_vector_float64_au = function (fname:string) ->

 let h = read_header_au fname

 and tmp1 = "tmp1" ^ fname

 and tmp2 = "tmp2" ^ fname

 and ic = open_in_bin fname in

  if compare h.(3) 7 != 0 then failwith "Bad encoding in Readwrite.read_vector_float64_au." ;

  begin

   try seek_in ic h.(1) with End_of_file -> failwith "Bad offset in Readwrite.read_vector_float64_au."

  end ;

  if h.(5) != 1 then failwith "Several channels in Readwrite.read_vector_float64_au." ;

  let fake = ref 0

  and count = ref 0 in

  begin

   try

    while true do

     fake := input_binary_int ic ;

     count := succ !count ;

    done

   with End_of_file -> close_in_noerr ic

  end ;

  let samples = !count / 2 in

   let v = Array.make samples 0. in

    write_float_array_value v tmp1 ;

    ignore ( Sys.command ( "head -c 22 " ^ tmp1 ^ " > " ^ tmp2 ) ) ;

    ignore ( Sys.command ( "tail -c+" ^ ( string_of_int ( succ h.(1) ) ) ^ " " ^ fname ^ " >> " ^ tmp2 ) ) ;

     let w = read_float_array_value tmp2 in

      Sys.remove tmp1 ;

      Sys.remove tmp2 ;

      w ;;






(** 
write_vector_float_to_float64_au
  *)


let write_vector_float_to_float64_au = fun (sample_rate:int) (v:float array) (fname:string) ->

 let oc = open_out fname

 and offset = 24

 and size = - 1

 and encoding = 7

 and channels = 1

 and tmp = "tmp" ^ fname in

  write_float_array_value v tmp ;

  output_string oc ".snd" ;

  set_binary_mode_out oc true ;

  output_binary_int oc offset ;

  output_binary_int oc size ;

  output_binary_int oc encoding ;

  output_binary_int oc sample_rate ;

  output_binary_int oc channels ;

  close_out_noerr oc ;

  ignore ( Sys.command ( "tail -c+23 " ^ tmp ^ " >> " ^ fname ) ) ;

  Sys.remove tmp ;;






(** 
read_matrix_float64_au
 *)


let read_matrix_float64_au = function (fname:string) ->

 let h = read_header_au fname

 and tmp1 = "tmp1" ^ fname

 and tmp2 = "tmp2" ^ fname

 and ic = open_in_bin fname in

  if compare h.(3) 7 != 0 then failwith "Bad encoding in Readwrite.read_matrix_float64_au." ;

  begin

   try seek_in ic h.(1) with End_of_file -> failwith "Bad offset in Readwrite.read_matrix_float64_au."

  end ;

  let fake = ref 0

  and channels = h.(5)

  and count = ref 0 in

  begin

   try

    while true do

     fake := input_binary_int ic ;

     count := succ !count ;

    done

   with End_of_file -> close_in_noerr ic

  end ;

  let samples = !count / 2 in

   let v = Array.make samples 0. in

    write_float_array_value v tmp1 ;

    ignore ( Sys.command ( "head -c 22 " ^ tmp1 ^ " > " ^ tmp2 ) ) ;

    ignore ( Sys.command ( "tail -c+" ^ ( string_of_int ( succ h.(1) ) ) ^ " " ^ fname ^ " >> " ^ tmp2 ) ) ;

     let w = read_float_array_value tmp2 in

      Sys.remove tmp1 ;

      Sys.remove tmp2 ;

      Util.vector_spray channels w ;;






(** 
write_matrix_float_to_float64_au
  *)


let write_matrix_float_to_float64_au = fun (sample_rate:int) (m:float array array) (fname:string) ->

 let oc = open_out fname

 and offset = 24

 and size = - 1

 and encoding = 7

 and channels = Array.length m

 and v = Util.vector_interlace m

 and tmp = "tmp" ^ fname in

  write_float_array_value v tmp ;

  output_string oc ".snd" ;

  set_binary_mode_out oc true ;

  output_binary_int oc offset ;

  output_binary_int oc size ;

  output_binary_int oc encoding ;

  output_binary_int oc sample_rate ;

  output_binary_int oc channels ;

  close_out_noerr oc ;

  ignore ( Sys.command ( "tail -c+23 " ^ tmp ^ " >> " ^ fname ) ) ;

  Sys.remove tmp ;;










(** 
§ 
 *)



(** 

Fichiers sons wav


Wav sound files

*)



(** 
 
 *)











(** The wav format is described in the following site.



http://www-mmsp.ece.mcgill.ca/Documents/AudioFormats/WAVE/



Le format wav est décrit dans le site ci-dessus. *)







(** 
read_pcm_wav_header filename
 *)


let read_pcm_wav_header = function (fname:string) ->

 let ic = open_in fname

 and c = ref 'a'

 and n = ref 0

 and m = ref 1

 and s = ref ""

 and a = ref [] in

  let f = function () ->

   begin

    c := input_char ic ;

    s := String.make 1 !c ;

    for i = 1 to 3 do

     c := input_char ic ;

     s := !s ^ ( String.make 1 !c )

    done ;

    a := !s :: !a ;

   end

  and g = function (length:int) ->

   begin

    n := input_byte ic ;

    m := 1 ;

    for i = 2 to length do

     m := 256 * !m ;

     n := !n + !m * ( input_byte ic ) ;

    done ;

    a := ( string_of_int !n ) :: !a ;

   end in

    begin

     try

      begin

       f () ;

       g 4 ;

       f () ;

       f () ;

       g 4 ;

       g 2 ;

       g 2 ;

       g 4 ;

       g 4 ;

       g 2 ;

       g 2 ;

       f () ;

       g 4 ;

      end

     with _ ->

      close_in_noerr ic

    end ;

    Array.of_list ( List.rev !a ) ;;




(** 
read_pcm_wav filename
 *)


let read_pcm_wav = function (fname:string) ->

 let h = read_pcm_wav_header fname

 and factor = 256

 and ic = open_in fname in

  let number_of_samples = ( int_of_string h.(12) ) / ( int_of_string h.(9) )

  and number_of_bits_per_sample = int_of_string h.(10)

  and number_of_channels = int_of_string h.(6) in

   let signal = Array.make_matrix number_of_samples number_of_channels 0

   and number_of_bytes_per_sample = ( if number_of_bits_per_sample mod 8 <> 0 then failwith "Number of bits per sample not programmed in Readwrite.read_pcm_wav." ; number_of_bits_per_sample / 8 )

   and shift = int_of_float ( Util.int_float_power ( pred number_of_bits_per_sample ) 2. )

   and extract_value = fun (s:int) (radix:int) (bytes_per_sample:int) ->

    begin

     let output = ref 0 in

      begin

       match bytes_per_sample with

       | 1 ->

        begin

         output := input_byte ic ;

         output := !output - s ;

        end

       | 2 ->

        begin

         output := input_byte ic ;

         output := !output + factor * ( input_byte ic ) ;

         output := ( ( !output + s ) mod radix ) - s ;

        end

       | _ ->

        begin

         assert ( bytes_per_sample > 0 ) ;

         output := input_byte ic ;

         let m = ref 1 in

          for i = 1 to bytes_per_sample do

           m := factor * !m ;

           output := !output + !m * ( input_byte ic ) ;

          done ;

          output := ( ( !output + s ) mod radix ) - s ;

        end

      end ;

      !output

    end

   and cc = pred number_of_channels in

    let radix = 2 * shift in

     begin

      try

       begin

        for i = 1 to 44 do

         ignore ( input_byte ic )

        done ;

        set_binary_mode_in ic true ;

        for i = 0 to pred number_of_samples do

         let multi_sample = signal.(i) in

          for j = 0 to cc do

           multi_sample.(j) <- extract_value shift radix number_of_bytes_per_sample ;

          done

        done ;

        close_in_noerr ic

       end

      with _ -> 

       close_in_noerr ic

     end ;

     let coeff = 1. /. ( float shift ) in

      Matrix.float_transpose ( Matrix.matrix_float_scal_mult coeff ( Matrix.float_of_matrix signal ) ) ;;




(** 
write_pcm_wav sample_rate bytes_per_sample matrix filename
 *)


let write_pcm_wav = fun (sample_rate:int) (bytes_per_sample:int) (m:float array array) (fname:string) ->

 let oc = open_out fname

 and factor = 256

 and shift = ref 128

 and exponent = ref 1

 and number_of_channels = Array.length m

 and number_of_samples = Array.length m.(0)

 and bits_per_sample = 8 * bytes_per_sample in

  while !exponent < bytes_per_sample do

   shift := !shift * factor ;

   incr exponent ;

  done ;

  let data_rate = sample_rate * bytes_per_sample * number_of_channels

  and float_factor = float !shift

  and cc = pred number_of_channels

  and block_align = number_of_channels * bytes_per_sample in

   let data_size = number_of_samples * block_align

   and inject_value = fun (s:int) (bps:int) (value:int) ->

    begin

     let factor = 256 in

      match bps with

      | 1 ->

       begin

        let x = s + value in

         output_byte oc x ;

       end

      | 2 ->

       begin

        let x = value + s in

         let y = x mod factor in

          output_byte oc y ;

          output_byte oc ( x / factor )

       end

      | _ ->

       begin

        let x = ref ( value + s ) in

         let y = ref ( !x mod factor ) in

          output_byte oc !y ;

          for i = 2 to bps do

           x := !x / factor ;

           y := !x mod factor ;

           output_byte oc !y

          done ;

       end

    end in

     let dsm1 = data_size mod 1 in

      output_char oc 'R' ;

      output_char oc 'I' ;

      output_char oc 'F' ;

      output_char oc 'F' ;

      inject_value 0 4 ( 36 + data_size + dsm1 ) ;

      output_char oc 'W' ;

      output_char oc 'A' ;

      output_char oc 'V' ;

      output_char oc 'E' ;

      output_char oc 'f' ;

      output_char oc 'm' ;

      output_char oc 't' ;

      output_char oc ' ' ;

      inject_value 0 4 16 ;

      inject_value 0 2 1 ;

      inject_value 0 2 number_of_channels ;

      inject_value 0 4 sample_rate ;

      inject_value 0 4 data_rate ;

      inject_value 0 2 block_align ;

      inject_value 0 2 bits_per_sample ;

      output_char oc 'd' ;

      output_char oc 'a' ;

      output_char oc 't' ;

      output_char oc 'a' ;

      inject_value 0 4 data_size ;

      for i = 0 to pred number_of_samples do

       for j = 0 to cc do

        inject_value !shift bytes_per_sample ( int_of_float ( ( m.(j).(i) +. 1. ) *. float_factor ) ) ;

       done ;

      done ;

      if dsm1 <> 0 then

       inject_value 0 1 0 ;

      close_out_noerr oc ;;










(** 
§ 
 *)



(** 

Fichiers et répertoires


Files and directories

*)



(** 
 
 *)











(** 
sub_directories directory_name
 *)


let sub_directories = function (dname:string) ->

 let l = Sys.readdir dname

 and g = function x ->

  begin

   try

    Sys.is_directory ( Filename.concat dname x )

   with

    Sys_error unknown -> false

  end in

  let f = function x -> ( x , ( x.[0] != '.' ) && ( g x ) )

  and cmp = fun y z -> compare ( snd y ) ( snd z ) in

   let ll = Array.map f l in

    Array.sort cmp ll ;

    let l_l = Array.map snd ll in

     let first_true = Util.vector_find_first ( = ) true l_l in

      if first_true >= 0 then

       begin

        let lll = Array.sub ll first_true ( ( Array.length l ) - first_true ) in

         let result = Array.map fst lll in

          Array.sort compare result ;

          result

       end

      else

       [| |] ;;




(** 
sub_directories_with_parent directory_name
 *)


let sub_directories_with_parent = function (dname:string) ->

 Array.append [| ".." |] ( sub_directories dname ) ;;




(** 
sub_directories_with_current directory_name
 *)


let sub_directories_with_current = function (dname:string) ->

 Array.append [| "." |] ( sub_directories dname ) ;;




(** 
sub_directories_with_parent_and_current directory_name
 *)


let sub_directories_with_parent_and_current = function (dname:string) ->

 Array.append [| ".." ; "." |] ( sub_directories dname ) ;;






(** 
regular_files directory_name
 *)


let regular_files = function (dname:string) ->

 let l = Sys.readdir dname

 and g = function x ->

  begin

   try

    Sys.is_directory ( Filename.concat dname x )

   with

    Sys_error unknown -> false

  end in

  let f = function x -> ( x , ( x.[0] != '.' ) && ( g x ) )

  and cmp = fun y z -> compare ( snd y ) ( snd z ) in

   let ll = Array.map f l in

    Array.sort cmp ll ;

    let l_l = Array.map snd ll in

     let first_true = Util.vector_find_first ( = ) true l_l in

      if first_true > 0 then

       begin

        let lll = Array.sub ll 0 first_true in

         let result = Array.map fst lll in

          Array.sort compare result ;

          result

       end

      else

       begin

        if first_true = 0 then [| |]

        else

         begin

         let lll = Array.map fst ll in

          Array.sort compare lll ;

          lll

         end

       end ;;










(** 
§ 
 *)



(** 

Images réelles


Floating point pictures

*)



(** 
 
 *)











(** 
read_float_rgb red_name green_name blue_name
 *)


let read_float_rgb = fun (rname:string) (gname:string) (bname:string) ->

 let r = read_matrix_float64_au rname

 and g = read_matrix_float64_au gname

 and b = read_matrix_float64_au bname in

  [| r ; g ; b |] ;;






(** 
write_float_rgb rgb_matrix file_prefix
 *)


let write_float_rgb = fun (m:float array array array) (fname:string) ->

 assert ( Array.length m >= 3 ) ;

 let rname = fname ^ ".red.au"

 and gname = fname ^ ".green.au"

 and bname = fname ^ ".blue.au" in

  write_matrix_float_to_float64_au 0 m.(0) rname ;

  write_matrix_float_to_float64_au 1 m.(1) gname ;

  write_matrix_float_to_float64_au 2 m.(2) bname ;;










(** 
read_picture_float_rgb filename
 The accepted formats are: xpm, pgm binary, ppm binary.



Les formats acceptés sont : xpm, pgm binaire, ppm binaire.*)


let read_picture_float_rgb = function (s:string) ->

 let e = read_pnm_header s in

  match e.(0).[1] with

  | '6' -> read_ppm_binary_float_rgb s

  | '5' -> read_pgm_binary_float_rgb s

  | '4' -> read_pbm_binary_float_rgb s

  | _ -> xpm_float_rgb ( array_read_text_file s ) ;;










(** 
§ 
 *)



(** 

Environnement

*)



(** 
 
 *)











(** 
clear string
 *)


let clear = function (s:string) ->

 try

  ignore ( Sys.command ( "rm -f " ^ s ) )

 with _ ->

  () ;;




(** 
crew_bsd unit
 *)


let crew_bsd = function () ->

 array_write_text_file [| "#!/bin/sh" ; "sysctl -n kern.smp.cpus > tmp_cpu" ;

  "sysctl -n kern.smp.active >> tmp_cpu" ; "exit 0" |] "tmp_script.sh" ;

 ignore ( Sys.command "sh tmp_script.sh" ) ;

 let numbers = array_read_reverse_text_file "tmp_cpu" in

  clear "tmp_script.sh tmp_cpu" ;

  if int_of_string numbers.(0) == 0 then

   1

  else

   int_of_string numbers.(1) ;;




(** 
crew_linux_lscpu unit
 *)


let crew_linux_lscpu = function () ->

 array_write_text_file [| "#!/bin/sh" ; "lscpu -p | grep -v '#' | wc -l | tr -d ' ' > tmp_cpu" ; "exit 0" |] "tmp_script.sh" ;

 ignore ( Sys.command "sh tmp_script.sh" ) ;

 let number = List.hd ( list_read_reverse_text_file "tmp_cpu" ) in

  clear "tmp_script.sh tmp_cpu" ;

  int_of_string number ;;




(** 
crew_linux_sysctl unit
 *)


let crew_linux_sysctl = function () ->

 array_write_text_file [| "#!/bin/sh" ; "sysctl -a 2>1 | grep -v error | grep -o '[.]cpu[.0-9][.0-9]*' | grep -o '[0-9][0-9]*' | sort -u | wc -l | tr -d ' ' > tmp_cpu" ; "exit 0" |] "tmp_script.sh" ;

 ignore ( Sys.command "sh tmp_script.sh" ) ;

 let number = List.hd ( list_read_reverse_text_file "tmp_cpu" ) in

  clear "tmp_script.sh tmp_cpu" ;

  int_of_string number ;;




(** 
crew_unix unit
 *)


let crew_unix = function () ->

 array_write_text_file [| "#!/bin/sh" ; "dmesg | grep -oi 'CPU[0-9][0-9]*' | sort -u | wc -l | tr -d ' ' > tmp_cpu" ;

 "exit 0" |] "tmp_script.sh" ;

 ignore ( Sys.command "sh tmp_script.sh" ) ;

 let number = List.hd ( list_read_reverse_text_file "tmp_cpu" ) in

  clear "tmp_script.sh tmp_cpu" ;

  int_of_string number ;;






(** 
crew unit
 Number of active processors.



Nombre de processeurs en fonctionnement. *)


let crew = function () ->

 try

  begin

   let output = crew_bsd () in

    assert ( output > 0 ) ;

    output

  end

 with _ ->

  begin

   try

    begin

     let output = crew_linux_lscpu () in

      assert ( output > 0 ) ;

      output

    end

   with _ ->

    begin

     try

      begin

       let output = crew_linux_sysctl () in

        assert ( output > 0 ) ;

        output

      end

     with _ ->

      crew_unix ()

    end

  end ;;






(** 
cpu_freq unit
 Frequency in megahertz of the first processor.



Fréquence du premier processeur en mégahertz. *)


let cpu_freq = function () ->

 array_write_text_file [| "#!/bin/sh" ; "sysctl -n dev.cpu.0.freq | tr -d ' ' > tmp_freq" ; "exit 0" |] "tmp_script.sh" ;

 ignore ( Sys.command "sh tmp_script.sh" ) ;

 let freq = List.hd ( list_read_reverse_text_file "tmp_freq" ) in

  clear "tmp_script.sh tmp_freq" ;

  int_of_string freq ;;






(** 
free_ram unit
 Number of free bytes in Random access memory.



Nombre d'octets libres en mémoire vive. *)


let free_ram = function () ->

 array_write_text_file [| "#!/bin/sh" ; "vmstat -s | grep 'pages free' | grep -o '[0-9][0-9]*' > tmp_free_ram" ;

  "vmstat -s | grep 'bytes per page' | grep -o '[0-9][0-9]*' >> tmp_free_ram" ; "exit 0" |] "tmp_script.sh" ;

 ignore ( Sys.command "sh tmp_script.sh" ) ;

 let free = array_read_reverse_text_file "tmp_free_ram" in

  clear "tmp_script.sh tmp_free_ram" ;

  ( int_of_string free.(0) ) * ( int_of_string free.(1) ) ;;






(** 
free_disk unit
 Number of free kilobytes on the file system containing the current directory.



Nombre de kilooctets libres sur le système de fichiers contenant le répertoire courant. *)


let free_disk = function () ->

 array_write_text_file [| "#!/bin/sh" ; "df -k . | grep '/' | tr -s ' ' | cut -d ' ' -f 4 > tmp_free_disk" ; "exit 0" |] "tmp_script.sh" ;

 ignore ( Sys.command "sh tmp_script.sh" ) ;

 let free = List.hd ( list_read_reverse_text_file "tmp_free_disk" ) in

  clear "tmp_script.sh tmp_free_disk" ;

  int_of_string free ;;




(** 
line unit
 *)


let line = function () ->

 array_write_text_file [| "#!/bin/sh" ; "echo `apm -a` > tmp_line" ; "exit 0" |] "tmp_script.sh" ;

 ignore ( Sys.command "sh tmp_script.sh" ) ;

 let line = List.hd ( list_read_reverse_text_file "tmp_line" ) in

  clear "tmp_script.sh tmp_line" ;

  if int_of_string line == 0 then

   false

  else

   true ;;




(** 
battery unit
 *)


let battery = function () ->

 array_write_text_file [| "#!/bin/sh" ; "apm | grep -v 'APM' > tmp_batt" ;

  "acpiconf -i batt >> tmp_batt" ; "exit 0" |] "tmp_script.sh" ;

 ignore ( Sys.command "sh tmp_script.sh" ) ;

 let batt = array_read_text_file "tmp_batt" in

  clear "tmp_script.sh tmp_batt" ;

  Array.map ( Str.global_replace ( Str.regexp ( "\t" ) ) " " ) batt ;;




















(** 
§ § § 
 *)










end ;;

















module Infinitesimal = struct








(** 
§ 
 *)



(** 

Introduction

*)



(** 
 
 *)











(**
The mathematician will find in this module methods in order to:



    

  • calculate derivatives of functions and samples,
    • 



    

  • calculate Serret-Frenet frames and multi-curvatures of whatever parameterized or sampled curves,
    • 



    

  • calculate curvature of surfaces embedded in R^3,
    • 



    

  • interpolate samples,
    • 



    

  • calculate zeros of functions,
    • 



    

  • calculate critical points of functions,
    • 



    

  • calculate integrals of functions and samples,
    • 



    

  • calculate transforms of functions and samples,
    • 



    

  • solve ordinary differential equations,
    • 



    

  • calculate the exponential of a real square matrix.
    • 



Thanks to curryfication, the mathematician will be able to multiply and complexify the variants of calculus methods ad libitum and therefore to chose various tradeoffs between speed and accuracy.




Conventions




Vectors are rows of scalars (float or int), of type float array or int array.



A (bidimensional) matrix is a row vector,
each element of which being a row of the matrix.
Matrices are of type float array array or int array array.




Warning




When using local inversion, an exception probably means that some process 
of local inversion passed through a critical point.
The problem may arise during search of zeros or of critical points.
In this case, the start point has to be changed, or some method of zero finding 
should differentiate up to a lower order, or some parameters have to be tuned.
Sometimes diminishing the maximum number of steps might avoid the difficulty.




Sources




Most of the data and algorithms have been harvested on the internet.
Among the sites, one may quote wikipedia.org about the derivatives, the ordinary differential equations, the miscellaneous transforms
and http://people.sc.fsu.edu/~jburkardt and ACM algorithms http://www.netlib.org/toms/index.html about integration.
For the differential calculus, much comes from E. Ramis, C. Deschamps, J. Odoux : Cours de mathématiques spéciales tome 5, Masson, Paris 1981 ;
J Lelong_Ferrand, J.-M. Arnaudiès : Cours de mathématiques tome 3, Dunod, Paris.
For elliptic integrals, the definitions follow V. Prasolov, Y. Solovyev : Elliptic functions and elliptic integrals, AMS mathematical monographs, Providence 1997.
For the distributions, the curious reader will find a study of the links with the lambda-calculus in O. P. Misra : Distribution htoery in computer science, SCI TECH publishing, Houston 2002 ;
nevertheless we limit ourselves to the definitions of L. Schwartz : Théorie des distributions, Hermann, Paris 1966.



This module is distributed under the same licence as Ocaml.




§ 




La mathématicienne ou le mathématicien trouvera dans ce module des méthodes pour :



    

  • calculer des dérivées de fonctions et d'échantillons,
    • 



    

  • calculer des repères de Serret-Frenet et multicourbures sur des courbes qu'elles soient paramétrées ou échantillonnées,
    • 



    

  • calculer des courbures de surfaces plongées dans R^3,
    • 



    

  • interpoler des échantillons,
    • 



    

  • calculer des points d'annulations de fonctions,
    • 



    

  • calculer des points critiques de fonctions,
    • 



    

  • calculer des intégrales de fonctions et d'échantillons,
    • 



    

  • calculer des transformées de fonctions et d'échantillons,
    • 



    

  • résoudre des équations différentielles ordinaires,
    • 



    

  • calculer l'exponentielle d'une matrice carrée réelle.
    • 



Grâce à la curryfication, le mathématicien ou la mathématicienne pourra multiplier et complexifier les variantes de méthodes de calcul à volonté, et donc choisir différents compromis entre vitesse et précision.




Conventions




Les vecteurs sont des lignes de scalaires (float ou int), de type float array ou int array.



Une matrice (bidimensionnelle) est un vecteur ligne 
dont chaque élément est une ligne de la matrice. 
Les matrices sont de type float array array ou int array array.




Avertissement




En utilisant des inversions locales, une exception signifie probablement 
qu'un procédé d'inversion locale est passé par un point critique.
Le problème peut se produire aussi pendant la recherhe d'un zéro ou d'un point critique.
Dans ce cas, il faut changer le point de départ, ou prendre une méthode de recherche de zéro
qui dérive moins, ou ajuster divers paramètres.
Parfois, diminuer le nombre maximal de pas suffit à contourner la difficulté.




Sources




La plupart des données et algorithmes ont été glanés sur internet.
Parmi les sites, on peut citer wikipedia.org concernant la dérivation, les équations différentielles ordinaires,
les transformées diverses et http://people.sc.fsu.edu/~jburkardt concernant l'intégration.
Pour le calcul différentiel, beaucoup provient de E. Ramis, C. Deschamps, J. Odoux : Cours de mathématiques spéciales tome 5, Masson, Paris 1981 ; 
J Lelong_Ferrand, J.-M. Arnaudiès : Cours de mathématiques tome 3, Dunod, Paris .
Pour les intégrales elliptiques, les définitions suivent V. Prasolov, Y. Solovyev : Elliptic functions and elliptic integrals, AMS mathematical monographs, Providence 1997.
Pour les distributions, le lecteur curieux trouvera une étude des liens avec le lambda-calcul dans O. P. Misra : Distribution htoery in computer science, SCI TECH publishing, Houston 2002 ;
néanmoins nous nous limitons aux définitions de L. Schwartz : Théorie des distributions, Hermann, Paris 1966.



Ce module est distribué selon la même licence qu'Ocaml.




Copyright Stéphane Grognet 


Laboratoire de mathématiques Jean Leray UMR 6629 CNRS 


Fédération de recherche mathématique des Pays de la Loire 


IREM des Pays de la Loire - Université de Nantes 


version 0.4

*)



(**
@version 0.4
*)



(**
@author Stéphane Grognet
*)



(**
@since 2011, 2012, 2013
*)











(** 
§ 
 *)



(** 

Constructions

*)



(** 
 
 *)








open Util ;;

open Matrix ;;








(** 

Constantes


Constants

*)



(** 
 
 *)










let sqrt_of_2 = sqrt 2. ;;

let sqrt_of_3 = sqrt 3. ;;

let sqrt_of_5 = sqrt 5. ;;

let sqrt_of_6 = sqrt 6. ;;

let sqrt_of_15 = sqrt 15. ;;

let inv_sqrt_of_2 = 1. /. sqrt 2. ;;

let inv_sqrt_of_3 = 1. /. sqrt 3. ;;



let pi = atan2 0. (-1.) ;;

let halfpi = atan2 1. 0. ;;

let quarterpi = atan 1. ;;

let doublepi = 2. *. atan2 0. (-1.) ;;

let inv_sqrt_pi = 1. /. ( sqrt pi ) ;;

let inv_doublepi = 1. /. doublepi ;;

let inv_sqrt_doublepi = sqrt inv_doublepi ;;



let log_of_2 = log 2. ;;






(** 

Fonctions


Functions

*)



(** 
 
 *)











(** 
heaviside_step float
 *)


let heaviside_step = function (x:float) ->

 let y = x -. abs_float x in

  match y with

  | 0. -> 1.

  | _ -> 0. ;;




(** 
unit_bowl_indic vector
 *)


let unit_bowl_indic = function (x:float array) ->

 heaviside_step ( 1. -. ( Matrix.vector_float_norm_2 x ) ) ;;




(** 
bowl_indic center radius vector
 *)


let bowl_indic = fun (x0:float array) (r:float) (x:float array) ->

 let z = Matrix.vector_float_minus x x0 in

  let y = Matrix.vector_float_scal_left_div r z in

   unit_bowl_indic ( y ) ;;




(** 
float_sign float
 *)


let float_sign = function (x:float) ->

 float ( compare x 0. ) ;;




(** 
int_sign float
 *)


let int_sign = function (x:int) ->

 compare x 0 ;;






(** 
low_stirling real
 *)


let low_stirling = function (x:float) ->

 let a = sqrt ( doublepi *. x )

 and b = x *. ( ( log x ) -. 1. ) in

  a *. exp b ;;




(** 
up_stirling real
 *)


let up_stirling = function (x:float) ->

 let a = sqrt ( doublepi *. x )

 and b = x *. ( ( log x ) -. 1. ) +. 1. /. ( 12. *. x ) in

  a *. exp b ;;




(** 
stirling_bis
 *)


let stirling_bis = function (x:float) ->

 let a = sqrt ( doublepi *. x )

 and b = x *. ( ( log x ) -. 1. )

 and y = 1. /. ( 12. *. x ) in

  let c = 1. +. y *. ( 1. +. y *. ( 0.5 -. y *. ( 139. +. y *. 571. /. 4. ) /. 30. ) ) in

   a *. c *. exp b ;;






(** 
half_unit_circle float
 *)


let half_unit_circle = function (x:float) -> sqrt ( 1. -. x *. x ) ;;




(** 
gauss_bell float
 *)


let gauss_bell = function (x:float) -> exp ( -. x *. x /. 2. ) ;;




(** 
sin_inv float
 *)


let sin_inv = function (x:float) -> match x with

 | 0. -> 0.

 | _ -> sin (1. /. x ) ;;




(** 
sinc float
 *)


let sinc = function (x:float) -> match x with

 | 0. -> 1.

 | _ -> ( sin x ) /. x ;;




(** 
nsinc float
 *)


let nsinc = function (x:float) -> match x with

 | 0. -> 1.

 | _ -> let xx = pi *. x in ( sin xx ) /. xx ;;






(** 
real_float_solve_degree_2 a b c
 Gives the two solutions of a x ^ 2 + b x + c = 0.



Donne les deux solutions x de a x ^ 2 + b x + c = 0. *)


let real_float_solve_degree_2 = fun (a:float) (b:float) (c:float) ->

 let bb = b /. (-2.) in

  let delta = bb *. bb -. a *. c in

   if delta < 0. then failwith "Strictly negative discriminant in Infinitesimal.real_float_solve_degree_2."

   else let dd = sqrt delta in

    [| ( bb +. dd ) /. a ; ( bb -. dd ) /. a |] ;;






(** 
unit_circle angle
 *)


let unit_circle = function (x:float) -> [| cos x ; sin x |] ;;




(** 
ellipse a b t
 *)


let ellipse = fun (a:float) (b:float) (t:float) ->

 [| a *. ( cos t ) ; b *. ( sin t ) |] ;;




(** 
hyperbola a b t
 *)


let hyperbola = fun (a:float) (b:float) (t:float) ->

 [| a *. ( cosh t ) ; b *. ( sinh t ) |] ;;






(** 
polar_curve function angle
 *)


let polar_curve = fun (r:float -> float) (angle:float) ->

 [| ( r angle ) *. ( cos angle ) ; ( r angle ) *. ( sin angle ) |] ;;




(** 
polar_curve_bis function angle
 *)


let polar_curve_bis = fun (angle:float -> float) (r:float) ->

 [| r *. cos ( angle r ) ; r *. sin ( angle r ) |] ;;




(** 
rotating_frame function angle
 *)


let rotating_frame = fun (v:float -> float array) (angle:float) ->

 let c = cos angle

 and s = sin angle in

 [| ( v angle ).(0) *. c -. ( v angle ).(1) *. s ;

 ( v angle ).(0) *. s +. ( v angle ).(1) *. c |] ;;




(** 
cycloid rotating_radius drawing_radius time
 *)


let cycloid = fun (rotating_radius:float) (drawing_radius:float) (t:float) ->

 [| rotating_radius *. t -. drawing_radius *. sin t ; rotating_radius -. drawing_radius *. cos t |] ;;




(** 
trochoid big_radius signed_rotating_radius time
 *)


let trochoid = fun (a:float) (alpha:float) (t0:float) (b:float) (beta:float) (t1:float) (t:float) ->

 let v = Matrix.vector_float_scal_mult a ( unit_circle ( alpha *. ( t -. t0 ) ) )

 and w = Matrix.vector_float_scal_mult b ( unit_circle ( beta *. ( t -. t1 ) ) ) in

  Matrix.vector_float_plus v w ;;




(** 
epicycloid big_radius signed_rotating_radius time
 *)


let epicycloid = fun (r:float) (a:float) (t:float) ->

 let parameter = 1. +. r /. a in

  let v = Matrix.vector_float_scal_mult parameter ( unit_circle t )

  and w = unit_circle ( parameter *. t ) in

   Matrix.vector_float_scal_mult a ( Matrix.vector_float_minus v w ) ;;

  


(** 
cardioid time
 *)


 let cardioid = function (t:float) -> epicycloid 1. 1. t ;;




(** 
nephroid time
 *)


 let nephroid = function (t:float) -> epicycloid 1. 0.5 t ;;




(** 
hypocycloid_3 time
 *)


 let hypocycloid_3 = function (t:float) -> epicycloid 3. (-1.) t ;;




(** 
astroid time
 *)


 let astroid = function (t:float) -> epicycloid 1. (-0.25) t ;;




(** 
conic excentricity parameter time
 *)


let conic = fun (e:float) (p:float) (t:float) ->

 let r = p /. ( 1. -. e *. cos t ) in

  [| r *. cos t ; r *. sin t |] ;;




(** 
tractrix parameter time
 *)


let tractrix = fun (a:float) (t:float) ->

 let u = t /. a in

  [| t -. a *. tanh u ; a /. cosh u |] ;;




(** 
helicoid radius step float
 *)


let helicoid = fun (a:float) (b:float) (x:float) ->

 [| a *. cos x ; a *. sin x ; b *. x |] ;;




(** 
spherical_loxodromy radius parameter angle
 *)


let spherical_loxodromy = fun (radius:float) (parameter:float) (angle:float) ->

 let u = parameter *. angle in

  let r = radius /. ( cosh u ) in

   [| r *. cos angle ; r *. sin angle ; r *. tanh u |] ;;






(** 
revolution_surface function parameters
 *)


let revolution_surface = fun (f:float -> float) (v:float array) ->

 let angle = v.(0)

 and z = v.(1) in

  let r = f z in

   [| r *. ( cos angle ) ; r *. ( sin angle ) ; z |] ;;




(** 
pseudo_sphere parameters
 *)


let pseudo_sphere = fun (v:float array) ->

 let angle = v.(0)

 and t = v.(1) in

  let w = tractrix 1. t in

   let z = w.(0)

   and r = w.(1) in

    [| r *. cos angle ; r *. sin angle ; z |] ;;






(** 
cyl_coord_unit_sphere parameters
 *)


let cyl_coord_unit_sphere = fun (v:float array) ->

 let r = v.(0) and angle = v.(1) in

  [| r *. ( cos angle ) ; r *. ( sin angle ) ; sqrt ( 1. -. r *. r ) |] ;;




(** 
sph_coord_unit_sphere parameters
 *)


let sph_coord_unit_sphere = fun (v:float array) ->

 let site = v.(0)

 and azimut = v.(1) in

  let r = cos site in

   [| r *. cos azimut ; r *. sin azimut ; sin site |] ;;






(** 
cyl_coord_ellipsoid a b c parameters
 *)


let cyl_coord_ellipsoid = fun (a:float) (b:float) (c:float) (v:float array) ->

 Matrix.vector_float_coeff_prod [| a ; b ; c |] ( cyl_coord_unit_sphere v ) ;;




(** 
sph_coord_ellipsoid a b c parameters
 *)


let sph_coord_ellipsoid = fun (a:float) (b:float) (c:float) (v:float array) -> 

 Matrix.vector_float_coeff_prod [| a ; b ; c |] ( sph_coord_unit_sphere v ) ;;




(** 
graph_ellipsoid a b c parameters
 *)


let graph_ellipsoid = fun (a:float) (b:float) (c:float) (v:float array) ->

 let x = v.(0) /. a

 and y = v.(1) /. b in

  c *. sqrt ( 1. -. ( x *. x +. y *. y ) ) ;;








(** 
ln float
 *)


let ln = function (x:float) -> match x with

 | 0. -> [| 0. ; 0. |] ;

 | _ -> let y = x -. abs_float x in

  match y with

  | 0. -> [| log x ; 0. |] ;

  | _ -> [| log ( abs_float x ) ; pi |] ;;






(** 
log_bin float
 *)


let log_bin = function (x:float) ->

 ( log x ) /. log_of_2 ;;








(** The four following smoothing functions are symmetric. 
Their derivatives are null in zero up to the order equal to the number in the name minus 1.
They are flat at x=1.
They satisfy to the three following conditions.



f(0) = 0 ; f(0.5) = 0.5 ; |x| >= 1 ===> f( x ) = 0.



Les quatre fonctions régularisantes qui suivent sont paires.
Leurs dérivées s'annulent en zéro jusqu'à l'ordre égal au nombre du nom moins un.
Elles sont plates en x=1.
Elles satisfont aux trois conditions précédentes. *)





(** 
 
 *)





(** 
float_decay_16 real
 *)


let float_decay_16 = fun (x:float) ->

 let y = ref ( 1.95470663435444503 *. ( abs_float x ) ) in

  y := !y *. !y ;

  y := !y *. !y ;

  y := !y *. !y ;

  y := !y *. !y ;

  exp ( -. !y ) ;;




(** 
float_decay_8 real
 *)


let float_decay_8 = fun (x:float) ->

 let xx = abs_float x in

  let y = ref ( 1.91043901319464093 *. xx ) in

   y := !y *. !y ;

   y := !y *. !y ;

   y := !y *. !y ;

   exp ( -. !y *. ( exp ( abs_float ( 4. *. xx -. 2. ) ) ) ) ;;




(** 
float_decay_4 real
 *)


let float_decay_4 = fun (x:float) ->

 let xx = abs_float x in

  let y = ref ( 1.82488861156805693 *. xx ) in

   y := !y *. !y ;

   y := !y *. !y ;

  exp ( -. !y *. ( exp ( abs_float ( xx *. ( 9. *. xx -. 4.5 ) ) ) ) ) ;;




(** 
float_decay_2 real
 *)


let float_decay_2 = fun (x:float) ->

 let xx = abs_float x in

  let y = ref ( 1.66510922231539538 *. xx ) in

   y := !y *. !y ;

   exp ( -. !y *. ( exp ( abs_float ( xx *. xx *. ( 12. *. xx -. 6. ) ) ) ) ) ;;




(** 
regular_truncature_right function cliff beach real
 *)


let regular_truncature_right = fun (f:float -> float) (a:float) (b:float) (x:float) ->

 if ( a >= b ) then failwith "Bad order in Infinitesimal.regular_truncature_right." ;

 if x <= a then 1.

 else if x >= b then 0.

  else f ( ( x -. a ) /. ( b -. a ) ) ;;




(** 
regular_truncature_left function cliff beach real
 *)


let regular_truncature_left = fun (f:float -> float) (a:float) (b:float) (x:float) ->

 if ( a >= b ) then failwith "Bad order in Infinitesimal.regular_truncature_left." ;

 if x <= a then 0.

 else if x >= b then 1.

  else f ( ( b -. x ) /. ( b -. a ) ) ;;




(** 
partition_of_1_table function left_foot left_cliff right_cliff right_foot
 *)


let partition_of_1_table = fun (f:float -> float) (a:float) (b:float) (c:float) (d:float) (x:float) ->

 if ( ( a >= b ) or ( b >= c ) or ( c >= d ) ) then failwith "Bad order in Infinitesimal.partition_of_1_table." ;

 let y = regular_truncature_left f a b x

 and z = regular_truncature_right f c d x in

  y *. z ;;




(** 
partition_of_1_gap function left_cliff left_bottom right_bottom right_cliff
 *)


let partition_of_1_gap = fun (f:float -> float) (a:float) (b:float) (c:float) (d:float) (x:float) ->

 if ( ( a >= b ) or ( b >= c ) or ( c >= d ) ) then failwith "Bad order in Infinitesimal.partition_of_1_gap." ;

 let y = regular_truncature_right f a b x

 and z = regular_truncature_left f c d x in

  y +. z ;;








(** 
float_polynomial_1 coefficients real
 *)


let float_polynomial_1 = fun (c:float array) (x:float) ->

 let deg = ( Array.length c ) - 1 in

  let accu = ref c.(deg) in

   for i = deg - 1 downto 0 do

    accu := !accu *. x +. c.(i) ;

   done ;

   !accu ;;




(** 
float_polynomial_2 coefficients x y
 The coefficients are given in a matrix.
The columns match the increasing powers of the second varaible y, the rows match the increasing powers of the first variable x. 



Les coefficients sont stockés dans une matrice. Les colonnes correspondent aux puissances croissantes de la deuxième variable y,
les lignes aux puissances croissantes de la première variable x. *)


let float_polynomial_2 = fun (c:float array array) (x:float) (y:float) ->

 let deg_x = ( Array.length c ) - 1 in

  let accu_row = ref 0.

  and last = ref 0

  and accu = ref 0. in

   for i = deg_x downto 0 do

    let row = c.(i) in

     last := ( Array.length row ) - 1 ;

     accu_row := row.(!last) ;

     for j = !last - 1 downto 0 do

      accu_row := !accu_row *. y +. row.(j)

     done ;

     accu := !accu *. x +. !accu_row ;

   done ;

   !accu ;;






(** 
float_rational_1 coefficients_up coefficients_down real
 *)


let float_rational_1 = fun (num:float array) (denom:float array) (x:float) ->

 let numer = float_polynomial_1 num x

 and denomin = float_polynomial_1 denom x in

  numer /. denomin ;;






(** 
float_rational_2 coefficients_up coefficients_down real
 The coefficients of the dividend and of the divisor are given
by matrices as in the case of polynomials in two variables.



Les coefficients du numérateur et du dénominateur sont donnés dans des matrices comme pour les polynômes à deux variables. *)


let float_rational_2 = fun (num:float array array) (denom:float array array) (x:float) (y:float) ->

 let numer = float_polynomial_2 num x y

 and denomin = float_polynomial_2 denom x y in

  numer /. denomin ;;










(** 
§ 
 *)



(** 

Dérivation

*)



(** 
 
 *)











(** 
 
 *)



(** 

Fonctions dérivées


Derivated functions

*)



(** 
 
 *)











(** 
float_approx_deriv step function float
 *)


let float_approx_deriv = fun (step:float) (f:float -> float) (x:float) ->

 ( ( f ( x +. step ) ) -. ( f x ) ) /. step ;;




(** 
float_richardson_binary_deriv degree step function float
 *)


let rec float_richardson_binary_deriv = fun (degree:int) (step:float) (f:float -> float) (x:float) ->

 match degree with

 | 0 -> float_approx_deriv step f x

 | 1 -> ( 4. *. f ( x +. step *. 0.5 ) -. 3. *. ( f x ) -. f ( x +. step ) ) /. step

 | 2 -> ( 32. *. f ( x +. step /. 4. ) -. 21. *. ( f x ) -. 12. *. f ( x +. step *. 0.5 ) +. f ( x +. step ) ) /. ( 3. *. step )

 | _ -> let coeff = 2. ** ( float degree )

  and oo = degree - 1 in

   ( coeff *. ( float_richardson_binary_deriv oo ( step *. 0.5 ) f x ) -. ( float_richardson_binary_deriv oo step f x ) ) /. ( coeff -. 1. ) ;;




(** 
compensated_float_richardson_binary_deriv degree step function float
 *)


let compensated_float_richardson_binary_deriv = fun (degree:int) (step:float) (f:float -> float) (x:float) ->

 let seq = Array.make ( succ degree ) 0. in

  for i = 0 to degree do

   seq.(i) <- float_richardson_binary_deriv i step f x ;

  done ;

  Matrix.float_approx seq ;;




(** 
float_richardson_deriv radix degree step function real
 *)


let rec float_richardson_deriv = fun (radix:float) (degree:int) (step:float) (f:float -> float) (x:float) ->

 match degree with

 | 0 -> float_approx_deriv step f x

 | 1 -> let coeff = radix *. radix in

  ( coeff *. f ( x +. step /. radix ) +. ( 1. -. coeff ) *. ( f x ) -. f ( x +. step ) ) /. ( step *. ( radix -. 1. ) )

 | _ -> let coeff = radix ** ( float degree )

  and oo = degree - 1 in

   ( coeff *. ( float_richardson_deriv radix oo ( step /. radix ) f x ) -. ( float_richardson_deriv radix oo step f x ) ) /. ( coeff -. 1. ) ;;




(** 
compensated_float_richardson_deriv accelerator radix degree step function float
 A convergence accelerator for real sequences
must be provided, like for instance Matrix.float_approx.



Il faut fournir un accélérateur de convergence de suites réelles, comme par exemple Matrix.float_approx. *)


let compensated_float_richardson_deriv = fun accelerator (radix:float) (degree:int) (step:float) (f:float -> float) (x:float) ->

 let seq = Array.make ( succ degree ) 0. in

  for i = 0 to degree do

   seq.(i) <- float_richardson_deriv radix i step f x ;

  done ;

  accelerator seq ;;






(** 
vector_speed methode function real
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_speed = fun methode (f:float -> float array) (x:float) -> 

 let g = fun i y -> methode ( function z -> (f z).(i) ) y in 

  Array.mapi g ( Array.make ( Array.length (f x) ) x ) ;;






(** 
matrix_speed methode function real
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let matrix_speed = fun methode (f:float -> float array array) (x:float) ->

 let g = fun i y -> vector_speed methode ( function z -> (f z).(i) ) y in

  Array.mapi g ( Array.make ( Array.length (f x) ) x ) ;;






(** 
acceleration methode function float
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let acceleration = fun methode (f:float -> float array) (x:float) -> 

 let g = vector_speed methode f in

  vector_speed methode g x ;;






(** 
matrix_acceleration methode function real
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let matrix_acceleration = fun methode (f:float -> float array array) (x:float) ->

 let g = matrix_speed methode f in

  matrix_speed methode g x ;;






(** 
partial index vector float
 This function replaces the coordinate number i by the variable x inside of the vector v.



Cette fonction remplace la coordonnée numéro i par la variable x dans le vecteur v.*)


let partial = fun (i:int) (v:float array) (x:float) ->

 let l = Array.length v in

  let w = Array.make l 0. in

   for j = 0 to i - 1 do

    w.(j) <- v.(j) ;

   done ;

   w.(i) <- x ;

   for j = i + 1 to l - 1 do

    w.(j) <- v.(j) ;

   done ;

   w ;;






(** 
matrix_partial index vector float
 *)


let matrix_partial = fun (i:int) (j:int) (m:float array array) (x:float) ->

 let w = Matrix.matrix_float_copy m in

  w.(i).(j) <- x ;;






(** 
gradient methode function vector
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let gradient = fun methode (f:float array -> float) (v:float array) -> 

 let g = fun i y -> methode ( function z -> f ( partial i v z ) ) y in 

  Array.mapi g v ;;






(** 
tlm methode function vector
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let tlm = fun methode (f:float array -> float array) (v:float array) -> 

 let g = fun i y -> gradient methode ( function z -> (f z).(i) ) y in 

  Array.mapi g ( Array.make ( Array.length (f v) ) v ) ;;






(** 
div methode function vector
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let div = fun methode (f:float array -> float array) (v:float array) -> 

 let m = tlm methode f v

 and accu = ref 0. in

  let l = Array.length m

  and c = Array.length m.(0) in

   for i = 0 to ( min l c ) - 1 do

    accu := m.(i).(i) +. !accu

   done ;

   !accu ;;






(** 
det_jac methode function vector
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let det_jac = fun methode (f:float array -> float array) (v:float array) -> 

 let m = tlm methode f v in

  Matrix.float_slow_det m ;;






(** 
rot_curl methode function vector
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let rot_curl = fun methode (f:float array -> float array) (v:float array) -> 

 let l = Array.length v

 and c = Array.length (f v) in

  match [| l ; c |] with

  | [| 3 ; 3 |] -> let m = tlm methode f v in

   [| m.(2).(1) -. m.(1).(2) ; m.(0).(2) -. m.(2).(0) ; m.(1).(0) -. m.(0).(1) |]

  | _ -> failwith "Bad dimensions in Infinitesimal.rot_curl." ;;






(** 
hess methode function vector
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let hess = fun methode (f:float array -> float) (v:float array) -> 

 let g = gradient methode f in

  tlm methode g v ;;






(** 
float_jet methode order function
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let float_jet = fun methode (order:int) (f:float -> float) (x:float) ->

 let v = Array.make ( order + 1 ) f in

  for i = 1 to order do

   let g = function t -> methode v.(i - 1) t in

    v.(i) <- g

  done ;

  Array.map ( function h -> h x ) v ;;






(** 
float_poly_coeff methode order function
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let float_poly_coeff = fun methode (order:int) (f:float -> float) (x:float) ->

 let v = float_jet methode order f x

 and accu = ref 1. in

  for i = 2 to order do

   accu := !accu *. ( float i ) ;

   v.(i) <- v.(i) /. !accu ;

  done ;

  v ;;






(** 
vector_jet methode order function real
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_jet = fun methode (order:int) (f:float -> float array) (x:float) ->

 let v = Array.make ( order + 1 ) f in

  for i = 1 to order do

   let g = function y -> vector_speed methode v.(i - 1) y in

    v.(i) <- g

  done ;

  Array.map ( function h -> h x ) v ;;






(** 
matrix_jet methode order function real
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let matrix_jet = fun methode (order:int) (f:float -> float array array) (x:float) ->

 let v = Array.make ( order + 1 ) f in

  for i = 1 to order do

   let g = function y -> matrix_speed methode v.(i - 1) y in

    v.(i) <- g

  done ;

  Array.map ( function h -> h x ) v ;;






(** 
graph_curvature methode function real
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let graph_curvature = fun methode (f:float -> float) (x:float) ->

 let g = methode f in

  let h = methode g

  and y = g x in

   let z = h x

   and u = 1. +. y *. y in

    let v = sqrt u in

     z /. (u *. v ) ;;






(** 
curvature_2 methode function real
 The fonction must take its values in R^2. 
The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
La fonction doit être à valeurs dans R^2.*)


let curvature_2 = fun methode (f:float -> float array) (x:float) ->

 let g = vector_speed methode f in

  let h = vector_speed methode g

  and v = g x in

   let a = h x

   and v0 = v.(0)

   and v1 = v.(1) in

    let u = v0 *. v0 +. v1 *. v1 in

     ( v0 *. a.(1) -. v1 *. a.(0) ) /. ( u *. ( sqrt u ) ) ;;






(** 
developpee_2 methode function real
 The fonction must take its values in R^2. 
The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
La fonction doit être à valeurs dans R^2.*)


let developpee_2 = fun methode (f:float -> float array) (x:float) ->

 let g = vector_speed methode f in

  let h = vector_speed methode g

  and v = g x in

   let a = h x

   and v0 = v.(0)

   and v1 = v.(1) in

    let u = v0 *. v0 +. v1 *. v1

    and a0 = a.(0)

    and a1 = a.(1) in

     let p = a0 *. v0 +. a1 *. v1 

     and uu = 1. /. u in

      let kappa = ( v0 *. a1 -. v1 *. a0 ) *. ( uu *. ( sqrt uu ) ) in

       let r = 1. /. kappa in

        let n0 = ( a0 -. p *. v0 /. u ) *. r *. uu

        and n1 = ( a1 -. p *. v1 /. u ) *. r *. uu

        and position = f x in

         [| position.(0) +. r *. n0 ; position.(1) +. r *. n1 |] ;;






(** 
parallel_arc_2 methode function real
 The fonction must take its values in R^2. 
The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
La fonction doit être à valeurs dans R^2.*)


let parallel_arc_2 = fun methode (f:float -> float array) (parameter:float) (x:float) ->

 let g = vector_speed methode f in

  let h = vector_speed methode g

  and v = g x in

   let a = h x

   and v0 = v.(0)

   and v1 = v.(1) in

    let u = v0 *. v0 +. v1 *. v1

    and a0 = a.(0)

    and a1 = a.(1) in

     let p = a0 *. v0 +. a1 *. v1 

     and uu = 1. /. u in

      let kappa = ( v0 *. a1 -. v1 *. a0 ) *. ( uu *. ( sqrt uu ) ) in

       let r = 1. /. kappa in

        let n0 = ( a0 -. p *. v0 /. u ) *. r *. uu

        and n1 = ( a1 -. p *. v1 /. u ) *. r *. uu

        and position = f x in

         [| position.(0) +. parameter *. n0 ; position.(1) +. parameter *. n1 |] ;;






(** 
curvature methode function real
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let curvature = fun methode (f:float -> float array) (x:float) ->

 let g = vector_speed methode f in

  let a = vector_speed methode g x

  and v = g x in

   let p = Matrix.vector_float_scal_prod a v

   and nn = Matrix.vector_float_square_norm_2 v in

    let z = Matrix.vector_float_scal_mult nn a

    and zz = Matrix.vector_float_scal_mult p v in

     ( Matrix.vector_float_norm_2 ( Matrix.vector_float_minus z zz ) ) /. ( nn *. nn ) ;;






(** 
serret_frenet_3 methode function real
 The fonction must take its values in R^3. 
The (unidimensional) derivating method must contain the parameters, including the step.
The output gives the (curvature;torsion) vector, then the tangent vector,
then the normal vector, then the binormal vector.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
La fonction doit être à valeurs dans R^3. La sortie comporte le vecteur (courbure;torsion),
puis le vecteur tangent, puis le vecteur normal, puis le vecteur binormal. *)


let serret_frenet_3 = fun methode (f:float -> float array) (x:float) ->

 let g = vector_speed methode f in

  let h = vector_speed methode g

  and v = g x in

   let k = vector_speed methode h

   and a = h x

   and n = Matrix.vector_float_norm_2 v

   and nn = Matrix.vector_float_square_norm_2 v in

    let dertier = k x

    and tangent = Matrix.vector_float_scal_left_div n v

    and product = Util.vector_float_prod_3 v a in

     let p = Matrix.vector_float_norm_2 product in

      let binormal = Matrix.vector_float_scal_left_div p product

      and curvature = p /. ( n *. nn ) in

       let normal = Util.vector_float_prod_3 binormal tangent

       and torsion = ( Matrix.vector_float_scal_prod binormal dertier ) /. p in

        [| [| curvature ; torsion |] ; tangent ; normal ; binormal |] ;;






(** 
curvature_center_3 methode function real
 The fonction must take its values in R^3. 
The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
La fonction prend ses valeurs dans R^3. *)


let curvature_center_3 = fun methode (f:float -> float array) (x:float) ->

 let resultat = serret_frenet_3 methode f x in

  Matrix.vector_float_plus ( f x ) ( Matrix.vector_float_scal_mult ( 1. /. resultat.(0).(0) ) resultat.(2) ) ;;






(** 
parallel_arc_3 methode function parameter real
 The fonction must take its values in R^3. 
The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
La fonction prend ses valeurs dans R^3. *)


let parallel_arc_3 = fun methode (f:float -> float array) (parameter:float) (x:float) ->

 let resultat = serret_frenet_3 methode f x in

  Matrix.vector_float_plus ( f x ) ( Matrix.vector_float_scal_mult parameter resultat.(2) ) ;;






(** 
serret_frenet methode function real
 The (unidimensional) derivating method must contain the parameters, including the step.
The output gives the multi-curvature vector in a one-row matrix, then the Serret-Frenet frame presented row-by-row, 
then the product of all the curvatures in a matrix reduced to a scalar.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
La sortie comporte le vecteur multicourbure dans une matrice uniligne, puis le repère de Serret-Frenet ligne par ligne,
puis le produit de toutes les courbures dans une matrice réduite à un scalaire. *)


let serret_frenet = fun methode (f:float -> float array) (x:float) ->

 let dim = Array.length ( f x )

 and accu = ref 1. in

  let m = vector_jet methode dim f x

  and n = dim - 1 in

   let mm = Matrix.float_sub_matrix m 1 dim 0 n in

    let frame = Matrix.float_trans_orthonormalize mm

    and curvature = Array.make n 0. in

     let celer = Matrix.vector_float_scal_prod mm.(0) frame.(0) in

      curvature.(0) <- ( Matrix.vector_float_scal_prod mm.(1) frame.(1) ) /. ( celer *. celer ) ;

      accu := curvature.(0) ;

      for i = 2 to n do

       curvature.( i - 1 ) <- ( Matrix.vector_float_scal_prod mm.(i) frame.(i) ) /. ( !accu *. ( celer ** ( float ( i + 1 ) ) ) ) ;

       accu := !accu *. curvature.( i - 1 ) ;

      done ;

      [| [| curvature |] ; frame ; [| [| !accu |] |] |] ;;






(** 
curvature_center methode function real
 The fonction must take its values in R^2. 
The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
La fonction doit être à valeurs dans R^2.*)


let curvature_center = fun methode (f:float -> float array) (x:float) ->

 let g = vector_speed methode f in

  let a = vector_speed methode g x

  and v = g x in

   let p = Matrix.vector_float_scal_prod a v

   and nn = Matrix.vector_float_square_norm_2 v in

    let z = Matrix.vector_float_scal_mult nn a

    and zz = Matrix.vector_float_scal_mult p v

    and u = 1. /. nn in

     let w = Matrix.vector_float_scal_mult ( u *. u ) ( Matrix.vector_float_minus z zz ) in

      let kappa = Matrix.vector_float_norm_2 w in

       let ww = Matrix.vector_float_scal_mult ( 1. /. ( kappa *. kappa ) ) w in

        Matrix.vector_float_plus ( f x ) ww ;;






(** 
parallel_arc methode function parameter real
 The fonction must take its values in R^2. 
The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
La fonction doit être à valeurs dans R^2.*)


let parallel_arc = fun methode (f:float -> float array) (parameter:float) (x:float) ->

 let g = vector_speed methode f in

  let a = vector_speed methode g x

  and v = g x in

   let p = Matrix.vector_float_scal_prod a v

   and nn = Matrix.vector_float_square_norm_2 v in

    let z = Matrix.vector_float_scal_mult nn a

    and zz = Matrix.vector_float_scal_mult p v

    and u = 1. /. nn in

     let w = Matrix.vector_float_scal_mult ( u *. u ) ( Matrix.vector_float_minus z zz ) in

      let kappa = Matrix.vector_float_norm_2 w in

       let ww = Matrix.vector_float_scal_mult ( parameter /. kappa ) w in

        Matrix.vector_float_plus ( f x ) ww ;;








(** 
fond_form_I methode function position vector1 vector2
 *)


let fond_form_I = fun methode (f:float array -> float array) (position:float array) (vector1:float array) (vector2:float array) ->

 let a = tlm methode f position in

  let w1 = Matrix.matrix_vector_float_prod a vector1

  and w2 = Matrix.matrix_vector_float_prod a vector2 in

   Matrix.vector_float_scal_prod w1 w2 ;;






(** 
surface_normal_3 methode f position
 The function must take its varaiables in R^2 and its values in R^3.



La fonction doit aller de R^2 dans R^3. *)


let surface_normal_3 = fun methode (f:float array -> float array) (position:float array) ->

 let a = tlm methode f position in

  let b = Matrix.float_transpose a in

   let v = Util.vector_float_prod_3 b.(0) b.(1) in

    let l = Matrix.vector_float_norm_2 v in

     Matrix.vector_float_scal_left_div l v ;;






(** 
surface_area_element_3 methode f position
 The function must take its varaiables in R^2 and its values in R^3.



La fonction doit aller de R^2 dans R^3. *)


let surface_area_element_3 = fun methode (f:float array -> float array) (position:float array) ->

 let a = tlm methode f position in

  let b = Matrix.float_transpose a in

   let v = Util.vector_float_prod_3 b.(0) b.(1) in

    Matrix.vector_float_norm_2 v ;;






(** 
surface_area_vector_3 methode f position
 The function must take its varaiables in R^2 and its values in R^3.



La fonction doit aller de R^2 dans R^3. *)


let surface_area_vector_3 = fun methode (f:float array -> float array) (position:float array) ->

 let a = tlm methode f position in

  let b = Matrix.float_transpose a in

   Util.vector_float_prod_3 b.(0) b.(1) ;;






(** 
surface_weingarten_3 methode f position
 The function must take its varaiables in R^2 and its values in R^3.



La fonction doit aller de R^2 dans R^3. *)


let surface_weingarten_3 = fun methode (f:float array -> float array) (position:float array) ->

 let n = surface_normal_3 methode f in

  let w = tlm methode n position

  and ww = tlm methode f position in

   let www = Matrix.float_transpose ww in

    let w_ww = Matrix.float_trans_orthonormalize www in

     let w_w = Matrix.matrix_float_prod w_ww ww in

      let w_inv = Matrix.clean_inv w_w in

       Matrix.matrix_float_triple_prod w_ww w w_inv ;;






(** 
surface_fond_form_II_3 methode function position vector1 vector2
 *)


let surface_fond_form_II_3 = fun methode (f:float array -> float array) (position:float array) (vector1:float array) (vector2:float array) ->

 fond_form_I methode f position vector1 ( Matrix.matrix_vector_float_prod (surface_weingarten_3 methode f position ) vector2 ) ;;






(** 
surface_principal_curvatures_3 methode function position
 *)


let surface_principal_curvatures_3 = fun methode (f:float array -> float array) (position:float array) ->

 let s = surface_weingarten_3 methode f position in

  let a = s.(0).(0)

  and b = 0.5 *. ( s.(0).(1) +. s.(1).(0) )

  and d = s.(1).(1) in

   real_float_solve_degree_2 1. ( -. ( a +. d ) ) ( a *. d -. b *. b ) ;;




(** 
surface_principal_curvatures_3_bis threshold max_steps methode function position
 *)


let surface_principal_curvatures_3_bis = fun (threshold:float) (max_steps:int) methode (f:float array -> float array) (position:float array) ->

 let a = surface_weingarten_3 methode f position in

  let s = Matrix.float_sym a in

   ( Matrix.sym_float_tune_reduc threshold max_steps s ).(0).(0) ;;






(** 
surface_ombilic_deviation_3 methode function position
 *)


let surface_ombilic_deviation_3 = fun methode (f:float array -> float array) (position:float array) ->

 let k = surface_principal_curvatures_3 methode f position in

  let a = k.(0)

  and b = k.(1) in

   let z = ( abs_float a ) +. ( abs_float b ) in

    if z = 0. then 0. else ( a -. b ) /. z ;;




(** 
surface_ombilic_deviation_3_bis threshold max_steps methode function position
 *)


let surface_ombilic_deviation_3_bis = fun (threshold:float) (max_steps:int) methode (f:float array -> float array) (position:float array) ->

 let k = surface_principal_curvatures_3_bis threshold max_steps methode f position in

  let a = k.(0)

  and b = k.(1) in

   let z = ( abs_float a ) +. ( abs_float b ) in

    if z = 0. then 0. else ( a -. b ) /. z ;;






(** 
surface_mean_curvature_3 methode function position
 *)


let surface_mean_curvature_3 = fun methode (f:float array -> float array) (position:float array) ->

 let s = surface_weingarten_3 methode f position in

  0.5 *. ( s.(0).(0) +. s.(1).(1) ) ;;




(** 
surface_mean_curvature_3_bis threshold max_steps methode function position
 *)


let surface_mean_curvature_3_bis = fun (threshold:float) (max_steps:int) methode (f:float array -> float array) (position:float array) ->

 let k = surface_principal_curvatures_3_bis threshold max_steps methode f position in

  0.5 *. ( k.(0) +. k.(1) ) ;;






(** 
surface_gauss_curvature_3 methode function position
 *)


let surface_gauss_curvature_3 = fun methode (f:float array -> float array) (position:float array) ->

 let s = surface_weingarten_3 methode f position in

  s.(0).(0) *. s.(1).(1) -. s.(0).(1) *. s.(1).(0) ;;




(** 
surface_gauss_curvature_3_bis threshold max_steps methode function position
 *)


let surface_gauss_curvature_3_bis = fun (threshold:float) (max_steps:int) methode (f:float array -> float array) (position:float array) ->

 let k = surface_principal_curvatures_3_bis threshold max_steps methode f position in

  k.(0) *. k.(1) ;;






(** 
graph_surface_3 function position
 The function must take its variables in R^2 and its values in R.



La fonction doit aller de R^2 dans R. *)


let graph_surface_3 = fun (f:float array -> float) (v:float array) ->

 Array.append v [| f v |] ;;






(** 
graph_principal_curvatures_3 function position
 The function must take its variables in R^2 and its values in R.



La fonction doit aller de R^2 dans R. *)


let graph_principal_curvatures_3 = fun methode (f:float array -> float) (position:float array) ->

 surface_principal_curvatures_3 methode ( graph_surface_3 f ) position ;;






(** 
graph_principal_curvatures_3_bis threshold max_steps function position
 The function must take its variables in R^2 and its values in R.



La fonction doit aller de R^2 dans R. *)


let graph_principal_curvatures_3_bis = fun (threshold:float) (max_steps:int) methode (f:float array -> float) (position:float array) ->

 surface_principal_curvatures_3_bis threshold max_steps methode ( graph_surface_3 f ) position ;;






(** 
graph_mean_curvature_3 function position
 The function must take its variables in R^2 and its values in R.



La fonction doit aller de R^2 dans R. *)


let graph_mean_curvature_3 = fun methode (f:float array -> float) (position:float array) ->

 surface_mean_curvature_3 methode ( graph_surface_3 f ) position ;;






(** 
graph_mean_curvature_3_bis threshold max_steps function position
 The function must take its variables in R^2 and its values in R.



La fonction doit aller de R^2 dans R. *)


let graph_mean_curvature_3_bis = fun methode (threshold:float) (max_steps:int) (f:float array -> float) (position:float array) ->

 surface_mean_curvature_3_bis threshold max_steps methode ( graph_surface_3 f ) position ;;






(** 
graph_gauss_curvature_3 function position
 The function must take its variables in R^2 and its values in R.



La fonction doit aller de R^2 dans R. *)


let graph_gauss_curvature_3 = fun methode (f:float array -> float) (position:float array) ->

 surface_gauss_curvature_3 methode ( graph_surface_3 f ) position ;;






(** 
graph_gauss_curvature_3_bis threshold max_steps function position
 The function must take its variables in R^2 and its values in R.



La fonction doit aller de R^2 dans R. *)


let graph_gauss_curvature_3_bis = fun (threshold:float) (max_steps:int) methode (f:float array -> float) (position:float array) ->

 surface_gauss_curvature_3_bis threshold max_steps methode ( graph_surface_3 f ) position ;;










(** 
§ 
 *)



(** 

Dérivées discrètes


Discrete derivatives

*)



(** 
 
 *)











(** 
float_discrete_diff scale vector
 *)


let float_discrete_diff = fun scale (v:float array) ->

 let n = Array.length v

 and inv_scale = 1. /. scale in

  let w = Array.make ( n - 1 ) 0. in

    for i = 0 to ( n - 2 ) do

     w.(i) <- ( v.( i + 1 ) -. v.(i) ) *. inv_scale ;

    done ;

    w ;;






(** 
float_discrete_richardson_binary_diff degree scale vector
 The maximum degree taken into account is two.



Le degré plafonne à 2. *)


let float_discrete_richardson_binary_diff = fun (degree:int) (scale:float) (v:float array) ->

 let n = Array.length v in

  match degree with

  | 0 -> float_discrete_diff scale v

  | 1 -> let w = Array.make ( n - 2 ) 0.

   and inv_doublescale = 1. /. ( 2. *. scale ) in

    for i = 0 to ( n - 3 ) do

     w.(i) <- ( 4. *. v.( i + 1 ) -. 3. *. v.(i) -. v.( i + 2 ) ) *. inv_doublescale ;

    done ; 

    w

  | _ -> let w = Array.make ( n - 4 ) 0.

   and inv_otherscale = 1. /. ( 12. *. scale ) in

    for i = 0 to ( n - 5 ) do

     w.(i) <- ( 32. *. v.( i + 1 ) -. 21. *. v.(i) -. 12. *. v.( i + 2 ) +. v.( i + 4 ) ) *. inv_otherscale ;

    done ; 

    w ;;






(** 
float_discrete_richardson_diff radix scale vector
 The degree is equal to one.



Le degré vaut 1. *)


let float_discrete_richardson_diff = fun (radix:int) (scale:float) (v:float array) ->

 let n = Array.length v

 and r = float radix in

  let w = Array.make ( n - radix ) 0.

  and rr = r *. r

  and inv_otherscale = 1. /. ( r *. ( r -. 1. ) *. scale ) in

    for i = 0 to ( n - radix - 1 ) do

     w.(i) <- ( rr *. v.( i + 1 ) -. ( rr -. 1. ) *. v.(i) -. v.( i + radix ) ) *. inv_otherscale ;

    done ; 

    w ;;






(** 
mean_float_discrete_diff scale vector
 *)


let mean_float_discrete_diff = fun scale (v:float array) ->

 let n = Array.length v

 and inv_scale = 1. /. scale in

  let w = Array.make n 0.

  and nn = n - 1 in

   let inv_otherscale = 1. /. ( ( float nn ) *. scale ) in

    w.(0) <- ( v.(1) -. v.(0) ) *. inv_scale ;

    for i = 1 to ( n - 2 ) do

     w.(i) <- ( ( float ( nn - i ) ) *. v.( i + 1 ) +. ( float ( 2 * i - nn ) ) *. v.(i) -. ( float i ) *. v.( i - 1 ) ) *. inv_otherscale ;

    done ;

    w.( nn ) <- ( v.( nn ) -. v.( nn - 1 ) ) *. inv_scale ;

    w ;;






(** 
mean_float_discrete_richardson_binary_diff scale vector
 The degree is equal to 1.



Le degré vaut 1. *)


let mean_float_discrete_richardson_binary_diff = fun (scale:float) (v:float array) ->

 let n = Array.length v

 and inv_doublescale = 1. /. ( 2. *. scale )

 and inv_quadscale = 1. /. ( 4. *. scale )

 and inv_otherscale = 1. /. ( 8. *. scale ) in

  let nn = n - 1

  and w = Array.make n 0. in

   w.(0) <- ( 4. *. v.(1) -. 3. *. v.(0) -. v.(2) ) *. inv_doublescale ;

   w.(1) <- ( (-3.) *. v.(0) +. v.(1) +. 3. *. v.(2) -. v.(3) ) *. inv_quadscale ;

   for i = 2 to ( n - 3 ) do

    w.(i) <- ( (-3.) *. v.( i - 2 ) -. 2. *. v.( i - 1 ) +. 4. *. v.(i) +. 2. *. v.( i + 1 ) -. v.( i + 2 ) ) *. inv_otherscale ;

   done ; 

   w.( n - 2 ) <- ( (-3.) *. v.( nn - 3 ) +. v.( nn - 2 ) +. 3. *. v.( nn - 1 ) -. v.(nn) ) *. inv_quadscale ;

   w.( nn ) <- ( 4. *. v.( nn - 1 ) -. 3. *. v.( nn - 2 ) -. v.( nn ) ) *. inv_doublescale ;

   w ;;






(** 
discrete_trans_vector_speed methode scale position_matrix
 The data must be presented by coordinates.



Les données doivent être présentées coordonnées par coordonnées. *)


let discrete_trans_vector_speed = fun methode (scale:float) (position:float array array) ->

 let d = Array.length position in

  let vitesse = Array.make_matrix d 1 0. in

   for i = 0 to d - 1 do

    vitesse.(i) <- methode scale position.(i)

   done ;

   vitesse ;;






(** 
discrete_vector_speed methode scale position_matrix
 *)


let discrete_vector_speed = fun methode (scale:float) (position:float array array) ->

 Matrix.float_transpose ( discrete_trans_vector_speed methode scale ( Matrix.float_transpose position ) ) ;;






(** 
discrete_trans_acceleration methode scale position_matrix
 The data must be presented by coordinates.



Les données doivent être présentées coordonnées par coordonnées. *)


let discrete_trans_acceleration = fun methode (scale:float) (position:float array array) ->

 let d = Array.length position in

  let vitesse = Array.make_matrix d 1 0.

  and acceleration = Array.make_matrix d 1 0. in

   for i = 0 to d - 1 do

    begin 

     let w = methode scale position.(i) in

      acceleration.(i) <- methode scale w ;

      vitesse.(i) <- w ;

    end ;

   done ;

   acceleration ;;






(** 
discrete_acceleration methode scale position_matrix
 *)


let discrete_acceleration = fun methode (scale:float) (position:float array array) ->

 Matrix.float_transpose ( discrete_trans_acceleration methode scale ( Matrix.float_transpose position ) ) ;;






(** 
discrete_trans_jet methode order scale position_matrix
 The data must be presented by coordinates.



Les données doivent être présentées coordonnées par coordonnées. *)


let discrete_trans_jet = fun methode (order:int) (scale:float) (position:float array array) ->

 let d = Array.length position in

  let jet = Array.make_matrix ( order + 1 ) d [| 0. |] in

   for i = 0 to d - 1 do

    begin

     let w = ref position.(i) in

      jet.(0).(i) <- !w ;

      for o = 1 to order do 

       begin

        w := methode scale !w ;

        jet.(o).(i) <- !w ;

       end

      done ;

    end

   done ;

   jet ;;






(** 
discrete_jet methode order scale position_matrix
 *)


let discrete_jet = fun methode (order:int) (scale:float) (position:float array array) ->

 Util.transpose ( Array.map Matrix.float_transpose ( discrete_trans_jet methode order scale ( Matrix.float_transpose position ) ) ) ;;






(** 
discrete_graph_curvature methode scale vector
 *)


let discrete_graph_curvature = fun methode (scale:float) (position:float array) ->

 let first = methode scale position in

  let second = methode scale first in

   let n = Array.length second in

    let curvature = Array.make n 0. in

     for i = 0 to n - 1 do

      let coeff = first.(i) in

       let coefficient = 1. +. coeff *. coeff in

        curvature.(i) <- second.(i) /. ( coefficient *. ( sqrt coefficient ) )

     done ;

     curvature ;;






(** 
discrete_trans_curvature_2 methode scale position_matrix
 The data must be presented by coordinates.



Les données doivent être présentées coordonnées par coordonnées. *)


let discrete_trans_curvature_2 = fun methode (scale:float) (position:float array array) ->

 let second_jet = discrete_trans_jet methode 2 scale position in

  let first = second_jet.(1)

  and second = second_jet.(2) in

   let xdot = first.(0)

   and ydot = first.(1)

   and xsec = second.(0)

   and ysec = second.(1) in

    let n = Array.length xsec in

     let curvature = Array.make n 0. in

      for i = 0 to n - 1 do

       let v0 = xdot.(i)

       and v1 = ydot.(i)

       and a0 = xsec.(i)

       and a1 = ysec.(i) in

        let coeff = v0 *. v0 +. v1 *. v1 in

         curvature.(i) <- ( v0 *. a1 -. v1 *. a0 ) /. ( coeff *. ( sqrt coeff ) )

      done ;

      curvature ;;






(** 
discrete_curvature_2 methode scale position_matrix
 *)


let discrete_curvature_2 = fun methode (scale:float) (position:float array array) ->

 discrete_trans_curvature_2 methode scale ( Matrix.float_transpose position ) ;;






(** 
discrete_curvature methode scale position_matrix
 *)


let discrete_curvature = fun methode (scale:float) (position:float array array) ->

 let second_jet = discrete_jet methode 2 scale position in

  let first = second_jet.(1)

  and second = second_jet.(2) in

   let nn = Array.map Matrix.vector_float_square_norm_2 first

   and size = Array.length second in

    let p = Array.make size 0.

    and curvature = Array.make size 0. in

     for i = 0 to size - 1 do

      p.(i) <- Matrix.vector_float_scal_prod second.(i) first.(i) ;

      let z = Matrix.vector_float_scal_mult nn.(i) second.(i) ;

      and zz = Matrix.vector_float_scal_mult p.(i) first.(i) in

       curvature.(i) <- ( Matrix.vector_float_norm_2 ( Matrix.vector_float_minus z zz ) ) /. ( nn.(i) *. nn.(i) ) ;

     done ;

     curvature ;;








(** 
discrete_trans_curvature methode scale position_matrix
 The data must be presented by coordinates.



Les données doivent être présentées coordonnées par coordonnées. *)


let discrete_trans_curvature = fun methode (scale:float) (position:float array array) ->

 discrete_curvature methode scale ( Matrix.float_transpose position ) ;;






(** 
discrete_trans_serret_frenet methode scale position_matrix
 The samples at the input must be presented by coordinates.
The output gives the samples of the multi-curvature vector, then the samples of the Serret-Frenet frame, 
then the samples of the product of all the curvatures.



Les échantillons doivent être entrés coordonnée par coordonnée.
La sortie comporte les échantillons du vecteur multicourbure, puis les échantillons du repère de Serret-Frenet,
puis les échantillons du produit de toutes les courbures. *)


let discrete_trans_serret_frenet = fun methode (scale:float) (position:float array array) ->

 let dim = Array.length position in

  let dim_jet = discrete_trans_jet methode dim scale position

  and n = dim - 1 in

   let size = Array.length dim_jet.(dim).(n) in

    let accu = Array.make size 1.

    and celer = Array.make size 0.

    and curvature = Array.make_matrix size n 0.

    and frame = Array.make size ( Array.make_matrix dim dim 0. ) in

     let information = Array.sub dim_jet 1 dim in

      let m = Array.map Matrix.float_transpose information in

       let mm = Util.transpose m in

        for i = 0 to size - 1 do

         let repere = mm.(i) in

         frame.(i) <- Matrix.float_trans_orthonormalize repere ;

         celer.(i) <- Matrix.vector_float_scal_prod repere.(0) frame.(i).(0) ;

         curvature.(i).(0) <- ( Matrix.vector_float_scal_prod repere.(1) frame.(i).(1) ) /. ( celer.(i) *. celer.(i) ) ;

         accu.(i) <- curvature.(i).(0) ;

         for j = 2 to n do

          curvature.(i).( j - 1 ) <- ( Matrix.vector_float_scal_prod repere.(j) frame.(i).(j) ) /. ( accu.(i) *. ( celer.(i) ** ( float ( j + 1 ) ) ) ) ;

          accu.(i) <- accu.(i) *. curvature.(i).( j - 1 ) ;

         done ;

        done ;

        [| [| curvature |] ; frame ; [| [| accu |] |] |] ;;






(** 
discrete_serret_frenet methode scale position_matrix
 The output gives the samples of the multi-curvature vector, 
then the samples of the Serret-Frenet frame, then the samples of the product of all the curvatures.



La sortie comporte les échantillons du vecteur multicourbure, puis les échantillons du repère de Serret-Frenet,
puis les échantillons du produit de toutes les courbures. *)


let discrete_serret_frenet = fun methode (scale:float) (position:float array array) ->

 let dim = Array.length position.(0) in

  let dim_jet = discrete_jet methode dim scale position

  and n = dim - 1 in

   let size = Array.length dim_jet in

    let accu = Array.make size 1.

    and celer = Array.make size 0.

    and curvature = Array.make_matrix size n 0.

    and frame = Array.make size ( Array.make_matrix dim dim 0. ) in

     for i = 0 to size - 1 do

      let repere = Array.sub dim_jet.(i) 1 dim in

       frame.(i) <- Matrix.float_trans_orthonormalize repere ;

       celer.(i) <- Matrix.vector_float_scal_prod repere.(0) frame.(i).(0) ;

       curvature.(i).(0) <- ( Matrix.vector_float_scal_prod repere.(1) frame.(i).(1) ) /. ( celer.(i) *. celer.(i) ) ;

       accu.(i) <- curvature.(i).(0) ;

       for j = 2 to n do

        curvature.(i).( j - 1 ) <- ( Matrix.vector_float_scal_prod repere.(j) frame.(i).(j) ) /. ( accu.(i) *. ( celer.(i) ** ( float ( j + 1 ) ) ) ) ;

        accu.(i) <- accu.(i) *. curvature.(i).( j - 1 ) ;

       done ;

     done ;

     [| [| curvature |] ; frame ; [| [| accu |] |] |] ;;








(** 
discrete_partial_diff_x methode matrix
 The column numbers of the matrix correspond to the abscissae.
The method methode is that of one_dimensional discrete derivation.



Les numéros de colonnes de la matrice représentent les abscisses. La méthode methode est celle de dérivation discrète unidimensionnelle.*)


let discrete_partial_diff_x = fun methode (m:float array array) ->

 Array.map methode m ;;






(** 
discrete_partial_diff_y methode matrix
 The column numbers of the matrix correspond to the abscissae.
The method methode is that of one_dimensional discrete derivation.



Les numéros de colonnes de la matrice représentent les abscisses. La méthode methode est celle de dérivation discrète unidimensionnelle.*)


let discrete_partial_diff_y = fun methode (m:float array array) ->

 let w = Matrix.float_transpose m in

  Matrix.float_transpose ( discrete_partial_diff_x methode w ) ;;






(** 
discrete_area_element methode matrix
 The column numbers of the matrix correspond to the abscissae.
The method methode is that of one_dimensional discrete derivation.



Les numéros de colonnes de la matrice représentent les abscisses. La méthode methode est celle de dérivation discrète unidimensionnelle.*)


let discrete_area_element = fun methode (m:float array array) ->

 let w = discrete_partial_diff_x methode m

 and ww = discrete_partial_diff_y methode m

 and f = fun x y -> sqrt ( 1. +. x *. x +. y *. y ) in

  Matrix.matrix_float_apply2 f w ww ;;






(** 
discrete_gauss_curvature methode matrix
 The column numbers of the matrix correspond to the abscissae.
The method methode is that of one_dimensional discrete derivation.



Les numéros de colonnes de la matrice représentent les abscisses. La méthode methode est celle de dérivation discrète unidimensionnelle.*)


let discrete_gauss_curvature = fun methode (m:float array array) ->

 let w = discrete_partial_diff_x methode m

 and ww = discrete_partial_diff_y methode m

 and f = fun x y -> 1. /. ( 1. +. x *. x +. y *. y ) in

  let w_xx = discrete_partial_diff_x methode w

  and w_xy = discrete_partial_diff_x methode ww

  and w_yy = discrete_partial_diff_y methode ww

  and w1 = Matrix.matrix_float_apply2 f w ww in

   let w2 = Matrix.matrix_float_coeff_prod w_xx w_yy

   and w3 = Matrix.matrix_float_coeff_prod w_xy w_xy in

    let w4 = Matrix.matrix_float_minus w2 w3 in

     Matrix.matrix_float_coeff_prod w4 w1 ;;






(** 
discrete_mean_curvature methode matrix
 The column numbers of the matrix correspond to the abscissae.
The method methode is that of one_dimensional discrete derivation.



Les numéros de colonnes de la matrice représentent les abscisses. La méthode methode est celle de dérivation discrète unidimensionnelle.*)


let discrete_mean_curvature = fun methode (m:float array array) ->

 let w = discrete_partial_diff_x methode m

 and ww = discrete_partial_diff_y methode m

 and f = fun x y -> let z = 1. +. x *. x +. y *. y in 0.5 /. ( z *. ( sqrt z ) )

 and g = fun x y -> ( 1. +. x *. x ) *. y

 and h = fun x y -> (-2.) *. x *. y in

  let w_xx = discrete_partial_diff_x methode w

  and w_xy = discrete_partial_diff_x methode ww

  and w_yy = discrete_partial_diff_y methode ww

  and w0 = Matrix.matrix_float_coeff_prod w ww

  and w1 = Matrix.matrix_float_apply2 f w ww in

   let w2 = Matrix.matrix_float_apply2 g ww w_xx

   and w3 = Matrix.matrix_float_apply2 g w w_yy

   and w4 = Matrix.matrix_float_apply2 h w0 w_xy in

    let w5 = Matrix.matrix_float_plus w2 w3 in

     let w6 = Matrix.matrix_float_plus w5 w4 in

      Matrix.matrix_float_coeff_prod w6 w1 ;;






(** 
discrete_principal_curvatures methode matrix
 The column numbers of the matrix correspond to the abscissae.
The method methode is that of one_dimensional discrete derivation.



Les numéros de colonnes de la matrice représentent les abscisses. La méthode methode est celle de dérivation discrète unidimensionnelle.*)


let discrete_principal_curvatures = fun methode (m:float array array) ->

 let w = discrete_mean_curvature methode m

 and ww = discrete_gauss_curvature methode m

 and f = fun x y -> ( real_float_solve_degree_2 1. ( -. x )  y ).(0)

 and g = fun x y -> ( real_float_solve_degree_2 1. ( -. x ) y ).(1) in

  let w1 = Matrix.matrix_float_apply2 f w ww

  and w2 = Matrix.matrix_float_apply2 g w ww in

   [| w1 ; w2 |] ;;












(** 
§ 
 *)



(** 

Interpolation

*)



(** 
 
 *)











(** 
float_linear_interpol vector real
 *)


let float_linear_interpol = fun (v:float array) (x:float) ->

 let ll = ( Array.length v ) - 1 in

  if ( x <= 0. ) then v.(0) 

  else if x >= float ll then v.(ll)

   else let e = floor x in

    let index = int_of_float e

    and y = x -. e in

     y *. v.( index + 1 ) +. ( 1. -. y ) *. v.(index) ;;




(** 
float_regular_stair_interpol function vector real
 *)


let float_regular_stair_interpol = fun (f:float -> float) (v:float array) (x:float) ->

 let ll = ( Array.length v ) - 1 in

  if ( x <= 0. ) then v.(0) 

  else if x >= float ll then v.(ll)

   else let e = floor x in

    let index = int_of_float e

    and y = x -. e in

     let z = f y in

     z *. v.(index) +. ( 1. -. z ) *. v.( index+ 1 ) ;;




(** 
float_medium_interpol function vector real
 *)


let float_medium_interpol = fun (f:float -> float) (v:float array) (x:float) ->

 let ll = ( Array.length v ) - 1 in

  if ( x <= 0. ) then v.(0) 

  else if x >= float ll then v.(ll)

   else let e = floor x in

    let index = int_of_float e

    and y = x -. e in

     let z = f y in

      let w = 0.5 *. ( z +. 1. -. y ) in

       w *. v.(index) +. ( 1. -. w ) *. v.( index+ 1 ) ;;






(** 
float_fit_interpol methode function parameter vector real
 The absolute value of the parameter
conditions the importance of the differentiable stair interpolation against the importance of the linear
interpolation. The method methode is that of differentiation, and must preserve the size of the sample.



La valeur absolue du paramètre parameter dose l'importance de l'interpolation en escalier dérivable
contre l'importance de l'interpolation linéaire.
La méthode methode est celle de dérivation, et doit préserver la taille de l'échantillon. *)


let float_fit_interpol = fun methode (f:float -> float) (parameter:float) (v:float array) (x:float) ->

 let ll = ( Array.length v ) - 1

 and c = discrete_graph_curvature methode 1. v in

  if ( x <= 0. ) then v.(0) 

  else if x >= float ll then v.(ll)

   else let e = floor x in

    let index = int_of_float e

    and y = x -. e in

     let z = f y

     and coeff = abs_float ( tanh ( parameter *. c.(index) ) ) in

      let w = coeff *. z +. ( 1. -. coeff ) *. ( 1. -. y ) in

       w *. v.(index) +. ( 1. -. w ) *. v.( index + 1 ) ;;






(** 
float_tune_interpol methode function vector real
 The parameter scale is
used in the discrete differential method methode. 
It may be used here in order to tune the smoothing effect. In case of doubt, use 1.0.
The parameter is used for the interpolation float_fit_interpol applied to the
derivative. A value of 0.1 seems convenient.



Le paramètre scale est utilisé dans la méthode methode de différentiation discrète.
Il peut servir à doser l'effet de régularisation ici. Dans le doute, prendre 1.0.
Le paramètre parameter sert pour l'interpolation float_fit_interpol
appliquée à la dérivée. Une valeur de 0.1 paraît raisonnable. *)


let float_tune_interpol = fun methode (f:float -> float) (v:float array) (x:float) ->

 let ll = ( Array.length v ) - 1

 and c = discrete_graph_curvature methode 1e0 v in

  if ( x <= 0. ) then v.(0) 

  else if x >= float ll then v.(ll)

   else let parameter = 1e1 *. sinh ( float_medium_interpol f c x ) in

     float_fit_interpol methode f parameter v x ;;






(** 
vector_trans_interpol methode vector_sample
 The data must be presented by coordinates.



Les données doivent être présentées coordonnées par coordonnées. *)


let vector_trans_interpol = fun methode (v:float array array) (x:float) ->

 let r = Array.length v in

  let w = Array.make r 0. in

   for i = 0 to r - 1 do

    w.(i) <- methode v.(i) x ;

   done ;

   w ;;






(** 
vector_interpol methode vector_sample
  *)


let vector_interpol = fun methode (v:float array array) (x:float) ->

 vector_trans_interpol methode ( Matrix.float_transpose v ) x ;;






(** 
matrix_trans_interpol methode matrix_sample
 The data must be presented by coefficients.



Les données doivent être présentées coefficients par coefficients. *)


let matrix_trans_interpol = fun methode (m:float array array array) (x:float) ->

 let r = Array.length m

 and l = Array.length m.(0) in

  let w = Array.make_matrix r l 0. in

   for i = 0 to r - 1 do

    w.(i) <- vector_trans_interpol methode m.(i) x ;

   done ;

   w ;;






(** 
matrix_interpol methode matrix_sample
  *)


let matrix_interpol = fun methode (m:float array array array) (x:float) ->

 matrix_trans_interpol methode ( Array.map Matrix.float_transpose ( Util.transpose m ) ) x ;;






(** 
 
 *)





(** The following multi-variables interpolations are polymorphic.



Les interpolations à plusieurs variables qui suivent sont polymorphes. *)





(** 
 
 *)





(** 
interpol_2 methode matrix abscissa ordinate
 The row numbers correspond to the ordinates
and the column numbers correspond to the abscissae. The method methode is that of the chosen interpolation.



Les numéros de lignes correspondent aux ordonnées et les numéros de colonnes aux abscisses.
La méthode methode est la méthode d'interpolation choisie. *)


let interpol_2 = fun methode (m:'a array array) (x:float) (y:float) ->

 let intermed = fun i z -> methode m.(i) x

 and v = Array.make ( Array.length m ) 0. in

  let vv = Array.mapi intermed v in

   methode vv y ;;






(** 
interpol_3 methode matrix abscissa ordinate
 The row numbers correspond to the altitudes
and the following numbers correspond to the ordinates then the abscissae. The method methode is that of the chosen interpolation.



Les numéros de lignes correspondent aux cotes et les numéros suivants aux ordonnées puis abscisses.
La méthode methode est la méthode d'interpolation choisie. *)


let interpol_3 = fun methode (m:'a array array array) (x:float) (y:float) (z:float) ->

 let intermed = fun i z -> interpol_2 methode m.(i) x y

 and v = Array.make ( Array.length m ) 0. in

  let vv = Array.mapi intermed v in

   methode vv z ;;






(** 
interpol methode multi_vector abscissa ordinate
 The row numbers correspond to the last coordinate
and the following numbers correspond to the coordinates in reverse order. The method methode is that of the chosen interpolation.



Les numéros de lignes correspondent à la dernière coordonnée et les numéros suivants aux coordonnées en ordre inverse.
La méthode methode est la méthode d'interpolation choisie. *)


let rec interpol = fun methode (m:Matrix.float_or_array) (x:float array) ->

 let d = Matrix.foa_thickness m in

  match d with

  | 0 -> let mm = Matrix.vector_float_demakeup m in methode mm x.(0)

  | _ -> 

   let mm = Matrix.vector_foa_demakeup m in 

    let r = Array.length mm in

     let rr = r - 1 in

      let intermed = fun i z -> interpol methode mm.(i) ( Array.sub x 0 rr )

      and v = Array.make r 0. in

       let vv = Array.mapi intermed v in

        methode vv x.(rr) ;;










(** 
§ 
 *)



(** 

Zéros

*)



(** 
 
 *)











(** 
float_zero_secant maxstep function start
 This method may work for a root of order one.



Cette méthode peut fonctionner pour une racine d'ordre un.*)


let float_zero_secant = fun (maxstep:int) (f:float -> float) (a:float) ->

 let step = ref 0

 and x = ref a

 and z = ref a

 and xx = ref ( f a )

 and y = ref ( a +. Random.float ( abs_float ( a /. 10. ) +. sqrt epsilon_float ) ) in

  let yy = ref ( f !y )

  and xxx = ref ( abs_float !xx )

  and zz = ref !xx in

   let yyy = ref ( abs_float !yy )

   and zzz = ref ( abs_float !zz ) in

    let v = [| !xxx ; !yyy ; !zzz |] in

     while ( ( !step <= maxstep ) && ( !xx <> 0. ) ) do

      let pente = ( !x -. !y ) /. ( !yy -. !xx ) in

       z := !y +. !yy *. pente ;

       zz := f !z ;

       zzz := abs_float !zz ;

       v.(2) <- !zzz ;

       Array.fast_sort compare v ;

       if ( v.(0) = !zzz ) then ( y := !z ; yy := !zz ; yyy := !zzz ) ;

       if ( v.(0) = !xxx ) then ( y := !x ; yy := !xx ; yyy := !xxx ) ;

       if ( v.(1) = !zzz ) then ( x := !z ; xx := !zz ; xxx := !zzz ) ;

       if ( v.(1) = !yyy ) then ( x := !y ; xx := !yy ; xxx := !yyy ) ;

       step := !step + 1 ;

     done ;

     !x ;;






(** 
float_zero_newton methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let float_zero_newton = fun methode (maxstep:int) (f:float -> float) (a:float) ->

 let step = ref 0

 and x = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( f !x <> 0. ) ) do

   let pente = methode f !x

   and ordonnee = f !x in

    y := !x -. ordonnee /. pente ;

    step := !step + 1 ;

    if ( abs_float ( f !x ) > abs_float ( f !y ) ) then  x := !y

  done ;

  !x ;;






(** 
float_zero_halley methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let float_zero_halley = fun methode (maxstep:int) (f:float -> float) (a:float) ->

 let step = ref 0

 and g = function x -> 1. /. ( f x )

 and x = ref a in

  let y = ref !x

  and j = float_jet methode 2 g in

  while ( ( !step <= maxstep ) && ( f !x <> 0. ) ) do

   let num = ( j !x ).(1)

   and denom = ( j !x ).(2) in

    y := !x +. 2. *. num /. denom ;

    step := !step + 1 ;

    if ( abs_float ( f !x ) > abs_float ( f !y ) ) then  x := !y

  done ;

  !x ;;






(** 
float_zero_householder methode order maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let float_zero_householder = fun methode (order:int) (maxstep:int) (f:float -> float) (a:float) ->

 let step = ref 0

 and g = function x -> 1. /. ( f x )

 and x = ref a in

  let y = ref !x

  and j = float_jet methode order g in

  while ( ( !step <= maxstep ) && ( f !x <> 0. ) ) do

   let num = ( j !x ).( order - 1 )

   and denom = ( j !x ).(order) in

    y := !x +. ( float order ) *. num /. denom ;

    step := !step + 1 ;

    if ( abs_float ( f !x ) > abs_float ( f !y ) ) then  x := !y

  done ;

  !x ;;






(** 
float_zero_pot_pourri methode maxorder maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let float_zero_pot_pourri = fun methode (maxorder:int) (maxstep:int) (f:float -> float) (a:float) ->

 let step = ref 0

 and x = ref a

 and xx = ref ( f a )

 and y = ref a in

  let yy = ref !xx in

   while ( ( !step <= maxstep ) && ( !xx <> 0. ) ) do

    y := float_zero_secant 1 f !x ;

    yy := f !y ;

    if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ) ;

    y := float_zero_newton methode 1 f !x ;

    yy := f !y ;

    if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ) ;

    y := float_zero_halley methode 1 f !x ;

    yy := f !y ;

    if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ) ;

    if ( maxorder >= 3 ) then

     begin

      for order = 3 to maxorder do

       begin

        y := float_zero_householder methode order 1 f !x ;

        yy := f !y ;

        if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ) ;

       end

      done ;

     end ;

    step := !step + 1 ;

   done ;

   !x ;;






(** 
float_zero_pot_pourri_alea methode maxorder maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let float_zero_pot_pourri_alea = fun methode (maxorder:int) (maxstep:int) (f:float -> float) (a:float) ->

 let step = ref 0

 and excursion = ref ( ( float maxstep ) *. epsilon_float )

 and x = ref a

 and xx = ref ( f a )

 and y = ref a in

  let yy = ref !xx in

   while ( ( !step <= maxstep ) && ( !xx <> 0. ) ) do

    y := float_zero_secant 1 f !x ;

    yy := f !y ;

    if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ) ;

    y := float_zero_newton methode 1 f !x ;

    yy := f !y ;

    if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ) ;

    y := float_zero_halley methode 1 f !x ;

    excursion := 2. *. ( !y -. !x ) ; 

    if !excursion = 0. then excursion := ( float maxstep ) *. epsilon_float ;

    yy := f !y ;

    if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ) ;

    if ( maxorder >= 3 ) then

     begin

      for order = 3 to maxorder do

       begin

        y := float_zero_householder methode order 1 f !x ;

        yy := f !y ;

        if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ) ;

       end

      done ;

     end ;

    y := !x *. ( 1. -. Random.float !excursion) ;

    yy := f !y ;

    if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ) ;

    y := !x *. ( 1. +. Random.float !excursion) ;

    yy := f !y ;

    if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ) ;

    step := !step + 1 ;

   done ;

   !x ;;






(** 
float_zero_general methode maxorder maxstep function start
 The idea of the auxiliary function
comes from the HP journal of december 1979 about the HP34C calculator.
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
L'idée de la fonction auxiliaire provient du journal HP de décembre 1979 concernant la calculette HP34C.*)


let float_zero_general = fun methode (maxorder:int) (maxstep:int) (f:float -> float) (a:float) ->

 let g = function x -> ( exp ( -. abs_float ( f x ) ) -. 1. )

 and step = ref 0 in

  let x = ref a

  and xx = ref ( f a )

  and xxx = ref ( g a )

  and y = ref a in

   let yy = ref !xx

   and yyy = ref !xxx in

    while ( ( !step <= maxstep ) && ( !xx <> 0. ) ) do

     y := float_zero_pot_pourri methode maxorder 1 f !x ;

     yy := f !y ;

     if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ; xxx := g !y ) ;

     y := float_zero_pot_pourri methode maxorder 1 g !x ;

     yyy := g !y ;

     if ( abs_float !xxx > abs_float ( !yyy ) ) then ( x := !y ; xx := f !y ; xxx := !yyy ) ;

     step := !step + 1 ;

    done ;

    !x ;;






(** 
float_zero_general_alea methode maxorder maxstep function start
 The idea of the auxiliary function
comes from the HP journal of december 1979 about the HP34C calculator.
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
L'idée de la fonction auxiliaire provient du journal HP de décembre 1979 concernant la calculette HP34C.*)


let float_zero_general_alea = fun methode (maxorder:int) (maxstep:int) (f:float -> float) (a:float) ->

 let g = function x -> ( exp ( -. abs_float ( f x ) ) -. 1. )

 and step = ref 0 in

  let x = ref a

  and xx = ref ( f a )

  and xxx = ref ( g a )

  and y = ref a in

   let yy = ref !xx

   and yyy = ref !xxx in

    while ( ( !step <= maxstep ) && ( !xx <> 0. ) ) do

     y := float_zero_pot_pourri_alea methode maxorder 1 f !x ;

     yy := f !y ;

     if ( abs_float !xx > abs_float ( !yy ) ) then ( x := !y ; xx := !yy ; xxx := g !y ) ;

     y := float_zero_pot_pourri_alea methode maxorder 1 g !x ;

     yyy := g !y ;

     if ( abs_float !xxx > abs_float ( !yyy ) ) then ( x := !y ; xx := f !y ; xxx := !yyy ) ;

     step := !step + 1 ;

    done ;

    !x ;;






(** 
vector_float_zero_secant maxstep function start
 This method may work for a root of order one.



Cette méthode peut fonctionner pour une racine d'ordre un.*)


let vector_float_zero_secant = fun (maxstep:int) (f:float array -> float) (a:float array) ->

 let step = ref 0

 and x = ref a

 and z = ref a

 and xx = ref ( f a )

 and y = ref ( Matrix.vector_float_plus a ( Matrix.vector_float_bal_random ( Array.length a ) ( abs_float ( ( Matrix.vector_float_norm_inf a ) /. 10. ) +. sqrt epsilon_float ) ) ) in

  let yy = ref ( f !y )

  and xxx = ref ( abs_float !xx )

  and zz = ref !xx in

   let yyy = ref ( abs_float !yy )

   and zzz = ref ( abs_float !zz ) in

    let v = [| !xxx ; !yyy ; !zzz |] in

     while ( ( !step <= maxstep ) && ( !xx <> 0. ) ) do

      let pente = Matrix.vector_float_scal_left_div ( !yy -. !xx ) ( Matrix.vector_float_minus !x !y ) in

       z := Matrix.vector_float_plus !y ( Matrix.vector_float_scal_mult !yy pente ) ;

       zz := f !z ;

       zzz := abs_float !zz ;

       v.(2) <- !zzz ;

       Array.fast_sort compare v ;

       if ( v.(0) = !zzz ) then ( y := !z ; yy := !zz ; yyy := !zzz ) ;

       if ( v.(0) = !xxx ) then ( y := !x ; yy := !xx ; yyy := !xxx ) ;

       if ( v.(1) = !zzz ) then ( x := !z ; xx := !zz ; xxx := !zzz ) ;

       if ( v.(1) = !yyy ) then ( x := !y ; xx := !yy ; xxx := !yyy ) ;

       step := !step + 1 ;

     done ;

     !x ;;






(** 
desc_grad_zero methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let desc_grad_zero = fun methode (maxstep:int) (f:float array -> float) (a:float array) ->

 let step = ref 0

 and x = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( f !x <> 0. ) ) do

   let pente = gradient methode f !x

   and ordonnee = f !x in

     y := Matrix.vector_float_minus !x ( Matrix.vector_float_scal_right_div ordonnee pente ) ;

     step := !step + 1 ;

     if ( abs_float ( f !x ) > abs_float ( f !y ) ) then x := !y

  done ;

  !x ;;






(** 
vector_float_halley_zero methode_reduc methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.
The parameter n is the maximum number of steps for the pseudo-inverse of symmetric matrices.
The reduction method methode_reduc applies to real symmetric matrices.



La méthode de réduction methode_reduc s'applique aux matrices symétriques réelles.
La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas.
La paramètre n est le nombre maximal de pas pour le pseudo-inverse des matrices symétriques. *)


let vector_float_halley_zero = fun methode_reduc methode (maxstep:int) (f:float array -> float) (a:float array) ->

 let step = ref 0

 and x = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( f !x <> 0. ) ) do

   let pente = gradient methode f !x

   and quadra = Matrix.sym_float_pinv methode_reduc 1e-3 ( hess methode f !x ) in

     y := Matrix.vector_float_minus !x ( Matrix.matrix_vector_float_prod quadra pente ) ;

     step := !step + 1 ;

     if ( abs_float ( f !x ) > abs_float ( f !y ) ) then x := !y

  done ;

  !x ;;






(** 
vector_float_zero_general methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_float_zero_general = fun methode (maxstep:int) (f:float array -> float) (a:float array) ->

 let g = function x -> ( exp ( -. abs_float ( f x ) ) -. 1. )

 and step = ref 0

 and x = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( f !x <> 0. ) ) do

   y := vector_float_zero_secant 1 f !x ;

   x := !y ;

   y := desc_grad_zero methode 1 f !x ;

   x := !y ;

   y := vector_float_zero_secant 1 g !x ;

   x := !y ;

   y := desc_grad_zero methode 1 g !x ;

   x := !y ;

   step := !step + 1 ;

  done ;

  !x ;;






(** 
vector_float_zero_general_alea methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_float_zero_general_alea = fun methode (maxstep:int) (f:float array -> float) (a:float array) ->

 let g = function x -> ( exp ( -. abs_float ( f x ) ) -. 1. )

 and step = ref 0

 and l = Array.length a

 and excursion = ref ( ( float maxstep ) *. epsilon_float )

 and x = ref a

 and z = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( f !x <> 0. ) ) do

   y := vector_float_zero_secant 1 f !x ;

   x := !y ;

   y := desc_grad_zero methode 1 f !x ;

   x := !y ;

   y := vector_float_zero_secant 1 g !x ;

   x := !y ;

   y := desc_grad_zero methode 1 g !x ;

   x := !y ;

   excursion := 2. *. ( Matrix.vector_float_norm_inf ( Matrix.vector_float_minus !y !x ) ) ;

   if !excursion = 0. then excursion := ( float maxstep ) *. epsilon_float ;

   if ( abs_float ( f !x ) > abs_float ( f !y ) ) then x := !y ;

   z := Matrix.vector_float_bal_random l !excursion ;

   z := Matrix.vector_float_plus !z !y ;

   if ( abs_float ( f !z ) < abs_float ( f !y ) ) then ( x := !z ) ;

   step := !step + 1 ;

  done ;

  !x ;;






(** 
vector_float_zero_general_2 methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.
The reduction method methode_reduc applies to real symmetric matrices.



La méthode de réduction methode_reduc s'applique aux matrices symétriques réelles.
La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_float_zero_general_2 = fun methode_reduc methode (maxstep:int) (f:float array -> float) (a:float array) ->

 let g = function x -> ( exp ( -. abs_float ( f x ) ) -. 1. )

 and step = ref 0

 and x = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( f !x <> 0. ) ) do

   y := vector_float_zero_secant 1 f !x ;

   x := !y ;

   y := desc_grad_zero methode 1 f !x ;

   x := !y ;

   y := vector_float_halley_zero methode_reduc methode maxstep f !x ;

   x := !y ;

   y := vector_float_zero_secant 1 g !x ;

   x := !y ;

   y := desc_grad_zero methode 1 g !x ;

   x := !y ;

   y := vector_float_halley_zero methode_reduc methode maxstep g !x ;

   x := !y ;

   step := !step + 1 ;

  done ;

  !x ;;






(** 
vector_float_zero_general_2_alea methode_reduc methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.
The reduction method methode_reduc applies to real symmetric matrices.



La méthode de réduction methode_reduc s'applique aux matrices symétriques réelles.
La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_float_zero_general_2_alea = fun methode_reduc methode (maxstep:int) (f:float array -> float) (a:float array) ->

 let g = function x -> ( exp ( -. abs_float ( f x ) ) -. 1. )

 and step = ref 0

 and l = Array.length a

 and excursion = ref ( ( float maxstep ) *. epsilon_float )

 and x = ref a

 and z = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( f !x <> 0. ) ) do

   y := vector_float_zero_secant 1 f !x ;

   x := !y ;

   y := desc_grad_zero methode 1 f !x ;

   x := !y ;

   y := vector_float_halley_zero methode_reduc methode maxstep f !x ;

   x := !y ;

   y := vector_float_zero_secant 1 g !x ;

   x := !y ;

   y := desc_grad_zero methode 1 g !x ;

   x := !y ;

   y := vector_float_halley_zero methode_reduc methode maxstep g !x ;

   excursion := 2. *. ( Matrix.vector_float_norm_inf ( Matrix.vector_float_minus !y !x ) ) ;

   if !excursion = 0. then excursion := ( float maxstep ) *. epsilon_float ;

   if ( abs_float ( f !x ) > abs_float ( f !y ) ) then x := !y ;

   z := Matrix.vector_float_bal_random l !excursion ;

   z := Matrix.vector_float_plus !z !y ;

   if ( abs_float ( f !z ) < abs_float ( f !x ) ) then ( x := !z ) ;

   step := !step + 1 ;

  done ;

  !x ;;






(** 
vector_zero_newton methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_zero_newton = fun methode (maxstep:int) (f:float array -> float array) (a:float array) ->

 let step = ref 0

 and x = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( Matrix.vector_float_norm_inf ( f !x ) <> 0. ) ) do

   let pente = tlm methode f !x

   and ordonnee = f !x in

    let inverse = Matrix.clean_inv pente in

     y := Matrix.vector_float_minus !x ( Matrix.matrix_vector_float_prod inverse ordonnee ) ;

     step := !step + 1 ;

     if ( Matrix.vector_float_norm_inf ( f !x ) > Matrix.vector_float_norm_inf ( f !y ) ) then x := !y

  done ;

  !x ;;

  




(** 
vector_zero_general methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_zero_general = fun methode (maxstep:int) (f:float array -> float array) (a:float array) ->

 let step = ref 0

 and g = function vector -> Matrix.vector_float_norm_inf ( f vector )

 and x = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( g !x <> 0. ) ) do

   y := vector_zero_newton methode 1 f !x ;

   x := !y ;

   y := vector_float_zero_general methode 1 g !x ;

   x := !y ;

   step := !step + 1 ;

  done ;

  !x ;;






(** 
vector_zero_general_alea methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_zero_general_alea = fun methode (maxstep:int) (f:float array -> float array) (a:float array) ->

 let step = ref 0

 and g = function vector -> Matrix.vector_float_norm_inf ( f vector )

 and l = Array.length a

 and excursion = ref ( ( float maxstep ) *. epsilon_float )

 and x = ref a

 and z = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( g !x <> 0. ) ) do

   y := vector_zero_newton methode 1 f !x ;

   x := !y ;

   y := vector_float_zero_general_alea methode 1 g !x ;

   excursion := 2. *. ( Matrix.vector_float_norm_inf ( Matrix.vector_float_minus !y !x ) ) ;

   if !excursion = 0. then excursion := ( float maxstep ) *. epsilon_float ;

   if ( ( g !x ) > ( g !y ) ) then x := !y ;

   z := Matrix.vector_float_bal_random l !excursion ;

   z := Matrix.vector_float_plus !z !x ;

   if ( ( g !z ) < ( g !x ) ) then ( x := !z ) ;

   step := !step + 1 ;

  done ;

  !x ;;






(** 
vector_zero_general_2 methode_reduc methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.
The reduction method methode_reduc applies to real symmetric matrices.



La méthode de réduction methode_reduc s'applique aux matrices symétriques réelles.
La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_zero_general_2 = fun methode_reduc methode (maxstep:int) (f:float array -> float array) (a:float array) ->

 let step = ref 0

 and g = function vector -> Matrix.vector_float_norm_inf ( f vector )

 and x = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( g !x <> 0. ) ) do

   y := vector_zero_newton methode 1 f !x ;

   x := !y ;

   y := vector_float_zero_general_2 methode_reduc methode 1 g !x ;

   x := !y ;

   step := !step + 1 ;

  done ;

  !x ;;






(** 
vector_zero_general_2_alea methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.
The reduction method methode_reduc applies to real symmetric matrices.



La méthode de réduction methode_reduc s'applique aux matrices symétriques réelles.
La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_zero_general_2_alea = fun methode_reduc methode (maxstep:int) (f:float array -> float array) (a:float array) ->

 let step = ref 0

 and g = function vector -> Matrix.vector_float_norm_inf ( f vector )

 and l = Array.length a

 and excursion = ref ( ( float maxstep ) *. epsilon_float )

 and x = ref a

 and z = ref a

 and y = ref a in

  while ( ( !step <= maxstep ) && ( g !x <> 0. ) ) do

   y := vector_zero_newton methode 1 f !x ;

   x := !y ;

   y := vector_float_zero_general_2_alea methode_reduc methode 1 g !x ;

   excursion := 2. *. ( Matrix.vector_float_norm_inf ( Matrix.vector_float_minus !y !x ) ) ;

   if !excursion = 0. then excursion := ( float maxstep ) *. epsilon_float ;

   if ( g !y < g !x ) then ( x := !y ) ;

   z := Matrix.vector_float_bal_random l !excursion ;

   z := Matrix.vector_float_plus !z !x ;

   if ( g !z < g !x ) then ( x := !z ) ;

   step := !step + 1 ;

  done ;

  !x ;;






(** 
vector_matrix_zero_general methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_matrix_zero_general = fun methode (maxstep:int) (f:float array -> float array array) (a:float array) ->

 let g = function vector -> Array.map Matrix.vector_float_norm_inf ( f vector ) in

  vector_zero_general methode maxstep g a ;;






(** 
vector_matrix_zero_general_alea methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.



La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_matrix_zero_general_alea = fun methode (maxstep:int) (f:float array -> float array array) (a:float array) ->

 let g = function vector -> Array.map Matrix.vector_float_norm_inf ( f vector ) in

  vector_zero_general_alea methode maxstep g a ;;






(** 
vector_matrix_zero_general_2 methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.
The reduction method methode_reduc applies to real symmetric matrices.



La méthode de réduction methode_reduc s'applique aux matrices symétriques réelles.
La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_matrix_zero_general_2 = fun methode_reduc methode (maxstep:int) (f:float array -> float array array) (a:float array) ->

 let g = function vector -> Array.map Matrix.vector_float_norm_inf ( f vector ) in

  vector_zero_general_2 methode_reduc methode maxstep g a ;;






(** 
vector_matrix_zero_general_2_alea methode maxstep function start
 The (unidimensional) derivating method must contain the parameters, including the step.
The reduction method methode_reduc applies to real symmetric matrices.



La méthode de réduction methode_reduc s'applique aux matrices symétriques réelles.
La méthode de dérivation (unidimensionnelle) doit contenir les paramètres, y compris le pas. *)


let vector_matrix_zero_general_2_alea = fun methode_reduc methode (maxstep:int) (f:float array -> float array array) (a:float array) ->

 let g = function vector -> Array.map Matrix.vector_float_norm_inf ( f vector ) in

  vector_zero_general_2_alea methode_reduc methode maxstep g a ;;






(** 
matrix_zero methode function start
 The zeroing method 
(of a function which associates a matrix to a vector) must contain all the parameters.



La méthode d'annulation (d'une fonction qui à un vecteur associe une matrice) doit contenir tous les paramètres. *)


let matrix_zero = fun methode (f:float array array -> float array array) (a:float array array) ->

 let l = Array.length a in

  let g = function vector -> f ( Array.map Matrix.vector_float_demakeup ( Matrix.vector_foa_demakeup ( Matrix.vector_foa_cut l ( Matrix.Float_vector_cons vector ) ) ) ) in

   Array.map Matrix.vector_float_demakeup ( Matrix.vector_foa_demakeup ( Matrix.vector_foa_cut l ( Matrix.Float_vector_cons ( methode g ( Array.fold_left Array.append [| |] a ) ) ) ) ) ;;






(** 
matrix_vector_zero methode function start
 The zeroing method 
(of a function which associates a vector to a vector) must contain all the parameters.



La méthode d'annulation (d'une fonction qui à un vecteur associe un vecteur) doit contenir tous les paramètres. *)


let matrix_vector_zero = fun methode (f:float array array -> float array) (a:float array array) ->

 let l = Array.length a in

  let g = function vector -> f ( Array.map Matrix.vector_float_demakeup ( Matrix.vector_foa_demakeup ( Matrix.vector_foa_cut l ( Matrix.Float_vector_cons vector ) ) ) ) in

   Array.map Matrix.vector_float_demakeup ( Matrix.vector_foa_demakeup ( Matrix.vector_foa_cut l ( Matrix.Float_vector_cons ( methode g ( Array.fold_left Array.append [| |] a ) ) ) ) ) ;;






(** 
matrix_float_zero methode function start
 The zeroing method 
(of a function which associates a real to a vector) must contain all the parameters.



La méthode d'annulation (d'une fonction qui à un vecteur associe un réel) doit contenir tous les paramètres. *)


let matrix_float_zero = fun methode (f:float array array -> float) (a:float array array) ->

 let l = Array.length a in

  let g = function vector -> f ( Array.map Matrix.vector_float_demakeup ( Matrix.vector_foa_demakeup ( Matrix.vector_foa_cut l ( Matrix.Float_vector_cons vector ) ) ) ) in

   Array.map Matrix.vector_float_demakeup ( Matrix.vector_foa_demakeup ( Matrix.vector_foa_cut l ( Matrix.Float_vector_cons ( methode g ( Array.fold_left Array.append [| |] a ) ) ) ) ) ;;










(** 
§ 
 *)



(** 

Remarque


Remark

*)



(** 
 
 *)











(** When searching for zeros on discrete data via the interpolation, be aware of the
float_regular_stair_interpol and of the other methods of interpolation which use it.



En cas de recherche de zéros sur des données discrètes via l'interpolation,
se méfier de l'interpolation par escalier dérivable float_regular_stair_interpol et
des autres méthodes d'interpolation qui l'utilisent. *)











(** 
§ 
 *)



(** 

Intégration

*)



(** 
 
 *)











(** 
 
 *)



(** 

Fonctions intégrées


Integrated functions

*)



(** 
 
 *)











(** 
float_int_rect nintervals function a b
 *)


let float_int_rect = fun (n:int) (f:float -> float) (a:float) (b:float) ->

 let accu = ref 0.

 and length = ( b -. a ) /. ( float n )

 and nn = n - 1 in

  for i = 0 to nn do

   accu := !accu +. ( f ( a +. ( float i ) *. length ) ) *. length

  done ;

  !accu ;;






(** 
float_int_incr_rect ratio nintervals function a b
 The step increases exponentially 
from a to b. The ratio ratio is the decreasing ratio, situated strictly between 0 and 1.



Le pas croît exponentiellement de a vers b. Le taux ratio est le taux de décroissance, 
compris strictement entre 0 et 1. *)


let float_int_incr_rect = fun (ratio:float) (n:int) (f:float -> float) (a:float) (b:float) ->

 let accu = ref 0.

 and x = ref b

 and length = ref ( ( b -. a ) *. ( 1. -. ratio ) /. ( 1. -. ratio ** ( float n ) ) ) in

  for i = 0 to n - 1 do

   x := !x -. !length ;

   accu := !accu +. ( f !x ) *. !length ;

   length := ratio *. !length ;

  done ;

  !accu ;;






(** 
float_int_decr_rect ratio nintervals function a b
 The step decreases exponentially 
from a to b. The ratio ratio is the decreasing ratio, situated strictly between 0 and 1.



Le pas décroît exponentiellement de a vers b. Le taux ratio est le taux de décroissance, 
compris strictement entre 0 et 1. *)


let float_int_decr_rect = fun (ratio:float) (n:int) (f:float -> float) (a:float) (b:float) ->

 let accu = ref 0.

 and x = ref a

 and length = ref ( ( b -. a ) *. ( 1. -. ratio ) /. ( 1. -. ratio ** ( float n ) ) ) in

  for i = 0 to n - 1 do

   x := !x +. !length ;

   accu := !accu +. ( f !x ) *. !length ;

   length := ratio *. !length ;

  done ;

  !accu ;;






(** 
float_int_trapez nintervals function a b
 *)


let float_int_trapez = fun (n:int) (f:float -> float) (a:float) (b:float) ->

 let accu = ref 0.

 and length = ( b -. a ) /. ( float n )

 and nn = n - 1 in

  for i = 1 to nn do

   accu := !accu +. ( f ( a +. ( float i ) *. length ) ) *. length

  done ;

  accu := !accu +. ( f a +. f b ) *. length *. 0.5 ;

  !accu ;;






(** 
float_int_incr_trapez ratio nintervals function a b
 The step increases exponentially 
from a to b. The ratio ratio is the decreasing ratio, situated strictly between 0 and 1.



Le pas croît exponentiellement de a vers b. Le taux ratio est le taux de décroissance, 
compris strictement entre 0 et 1. *)


let float_int_incr_trapez = fun (ratio:float) (n:int) (f:float -> float) (a:float) (b:float) ->

 let accu = ref 0.

 and x = ref b

 and xx = ref b

 and length = ref ( ( b -. a ) *. ( 1. -. ratio ) /. ( 1. -. ratio ** ( float n ) ) ) in

  for i = 0 to n - 1 do

   x := !x -. !length ;

   accu := !accu +. ( ( f !x ) +. ( f !xx ) ) *. !length *. 0.5 ;

   length := ratio *. !length ;

   xx := !x ;

  done ;

  !accu ;;






(** 
float_int_decr_trapez ratio nintervals function a b
 The step decreases exponentially 
from a to b. The ratio ratio is the decreasing ratio, situated strictly between 0 and 1.



Le pas décroît exponentiellement de a vers b. Le taux ratio est le taux de décroissance, 
compris strictement entre 0 et 1. *)


let float_int_decr_trapez = fun (ratio:float) (n:int) (f:float -> float) (a:float) (b:float) ->

 let accu = ref 0.

 and x = ref a

 and xx = ref a

 and length = ref ( ( b -. a ) *. ( 1. -. ratio ) /. ( 1. -. ratio ** ( float n ) ) ) in

  for i = 0 to n - 1 do

   xx := !xx +. !length ;

   accu := !accu +. ( ( f !x ) +. ( f !xx ) ) *. !length *. 0.5 ;

   length := ratio *. !length ;

   x := !xx ;

  done ;

  !accu ;;






(** 
float_int_simpson nintervals function a b
 *)


let float_int_simpson = fun (n:int) (f:float -> float) (a:float) (b:float) ->

 let accu = ref 0.

 and length = ( b -. a ) /. ( 2. *. float n )

 and nn = n - 1 in

  for i = 1 to nn do

   accu := !accu +. ( f ( a +. ( float ( 2 * i ) ) *. length ) +. 2. *. f ( a +. ( float ( 2 * i + 1 ) ) *. length ) ) *. length *. 2. /. 3.

  done ;

  accu := !accu +. ( f a +. f b +. 4. *. f ( a +. length ) ) *. length /. 3. ;

  !accu ;;






(** 
float_int_romberg order degree function a b
 *)


let rec float_int_romberg = fun (n:int) (k:int) (f:float -> float) (a:float) (b:float) ->

 let kk = abs k

 and nn = abs n in

  match kk with

  | 0 -> float_int_trapez ( int_of_float ( 2. ** ( float nn ) ) ) f a b

  | 1 -> float_int_simpson ( int_of_float ( 2. ** ( float nn ) ) ) f a b

  | _ -> 

   let kkk = kk - 1

   and coeff = 4. ** ( float kk ) in

    let aa = float_int_romberg ( nn + 1 ) kkk f a b

    and bb = float_int_romberg nn kkk f a b in

     ( coeff *. aa -. bb ) /. ( coeff -. 1. ) ;;




(** 
float_int order degree function a b
 *)


let float_int = fun (n:int) (k:int) (f:float -> float) (a:float) (b:float) ->

 let nn = ( 2 * n ) / 3 in

  let seq = Array.make ( succ nn ) 0.

  and nnn = n - nn in

   for i = 0 to nn do

    seq.(i) <- float_int_romberg ( nnn + i ) k f a b ;

   done ;

   Matrix.float_approx seq ;;






(** 
float_int_monte_carlo nsamples function a b
 *)


let float_int_monte_carlo = fun (n:int) (f:float -> float) (a:float) (b:float) ->

 let accu = ref 0.

 and range = b -. a in

  let length = range /. ( float n ) in

   for i = 1 to n do

    accu := !accu +. ( f ( a +. Random.float range ) ) *. length

   done ;

   !accu ;;






(** 
float_romberg_step_trapez function a b
 *)


let float_romberg_step_trapez = fun (f:float -> float) (a:float) (b:float) ->

 ( f a +. f b ) *. ( b -. a ) *. 0.5 ;;




(** 
float_int_romberg_trapez_adapt tolerance function a b
 *)


let rec float_int_romberg_trapez_adapt = fun (tol:float) (f:float -> float) (a:float) (b:float) ->

 let first = float_romberg_step_trapez f a b

 and c = ( a +. b ) *. 0.5 in

  let second = ref ( float_romberg_step_trapez f a c +. float_romberg_step_trapez f c b ) in

   if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

    begin

     second := float_int_romberg_trapez_adapt tol f a c +. float_int_romberg_trapez_adapt tol f c b

    end ;

    !second ;;




(** 
float_int_romberg_trapez_bounded maxstages tolerance function a b
 *)


let rec float_int_romberg_trapez_bounded = fun (maxstages:int) (tol:float) (f:float -> float) (a:float) (b:float) ->

 match maxstages with 

 | 0 -> float_romberg_step_trapez f a b

 | _ -> 

  let first = float_romberg_step_trapez f a b

  and c = ( a +. b ) *. 0.5 in

   let second = ref ( float_romberg_step_trapez f a c +. float_romberg_step_trapez f c b ) in

    if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

     begin

      second := float_int_romberg_trapez_bounded ( ( abs maxstages ) - 1 ) tol f a c

       +. float_int_romberg_trapez_bounded ( ( abs maxstages ) - 1 ) tol f c b

     end ;

     !second ;;






(** 
float_romberg_step_simpson function a b
 *)


let float_romberg_step_simpson = fun (f:float -> float) (a:float) (b:float) ->

 ( f a +. f b +. 4. *. f ( ( a +. b ) *. 0.5 ) ) *. ( b -. a ) /. 6. ;;




(** 
float_int_romberg_simpson_adapt tolerance function a b
 *)


let rec float_int_romberg_simpson_adapt = fun (tol:float) (f:float -> float) (a:float) (b:float) ->

 let first = float_romberg_step_simpson f a b

 and c = ( a +. b ) *. 0.5 in

  let second = ref ( float_romberg_step_simpson f a c +. float_romberg_step_simpson f c b ) in

   if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

    begin

     second := float_int_romberg_simpson_adapt tol f a c +. float_int_romberg_simpson_adapt tol f c b

    end ;

    !second ;;




(** 
float_int_romberg_simpson_bounded maxstages tolerance function a b
 *)


let rec float_int_romberg_simpson_bounded = fun (maxstages:int) (tol:float) (f:float -> float) (a:float) (b:float) ->

 match maxstages with 

 | 0 -> float_romberg_step_simpson f a b

 | _ -> 

  let first = float_romberg_step_simpson f a b

  and c = ( a +. b ) *. 0.5 in

   let second = ref ( float_romberg_step_simpson f a c +. float_romberg_step_simpson f c b ) in

    if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

     begin

      second := float_int_romberg_simpson_bounded ( ( abs maxstages ) - 1 ) tol f a c

       +. float_int_romberg_simpson_bounded ( ( abs maxstages ) - 1 ) tol f c b

     end ;

     !second ;;






(** 
float_romberg_step_3_8 function a b
 *)


let float_romberg_step_3_8 = fun (f:float -> float) (a:float) (b:float) ->

 let step = ( b -. a ) /. 3. in

  ( f a +. f b +. 3. *. ( f ( a +. step ) +. f ( b -. step ) ) ) *. ( b -. a ) *. 0.125 ;;




(** 
float_int_romberg_3_8_adapt tolerance function a b
 *)


let rec float_int_romberg_3_8_adapt = fun (tol:float) (f:float -> float) (a:float) (b:float) ->

 let first = float_romberg_step_3_8 f a b

 and c = ( a +. b ) *. 0.5 in

  let second = ref ( float_romberg_step_3_8 f a c +. float_romberg_step_3_8 f c b ) in

   if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

    begin

     second := float_int_romberg_3_8_adapt tol f a c +. float_int_romberg_3_8_adapt tol f c b

    end ;

    !second ;;




(** 
float_int_romberg_3_8_bounded maxstages tolerance function a b
 *)


let rec float_int_romberg_3_8_bounded = fun (maxstages:int) (tol:float) (f:float -> float) (a:float) (b:float) ->

 match maxstages with 

 | 0 -> float_romberg_step_3_8 f a b

 | _ -> 

  let first = float_romberg_step_3_8 f a b

  and c = ( a +. b ) *. 0.5 in

   let second = ref ( float_romberg_step_3_8 f a c +. float_romberg_step_3_8 f c b ) in

    if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

     begin

      second := float_int_romberg_3_8_bounded ( ( abs maxstages ) - 1 ) tol f a c

       +. float_int_romberg_3_8_bounded ( ( abs maxstages ) - 1 ) tol f c b

     end ;

     !second ;;






(** 
float_romberg_step_milne function a b
 *)


let float_romberg_step_milne = fun (f:float -> float) (a:float) (b:float) ->

 let step = ( b -. a ) *. 0.25 in

 ( 7. *. ( ( f a ) +. ( f b ) ) +. 32. *. ( ( f ( a +. step ) ) +. ( f ( b -. step ) ) ) +. 12. *. ( f ( 0.5 *. ( a +. b ) ) ) ) *. ( b -. a ) /. 90. ;;




(** 
float_int_romberg_milne_adapt tolerance function a b
 *)


let rec float_int_romberg_milne_adapt = fun (tol:float) (f:float -> float) (a:float) (b:float) ->

 let first = float_romberg_step_milne f a b

 and c = ( a +. b ) *. 0.5 in

  let second = ref ( float_romberg_step_milne f a c +. float_romberg_step_milne f c b ) in

   if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

    begin

     second := float_int_romberg_milne_adapt tol f a c +. float_int_romberg_milne_adapt tol f c b

    end ;

    !second ;;




(** 
float_int_romberg_milne_bounded maxstages tolerance function a b
 *)


let rec float_int_romberg_milne_bounded = fun (maxstages:int) (tol:float) (f:float -> float) (a:float) (b:float) ->

 match maxstages with 

 | 0 -> float_romberg_step_milne f a b

 | _ -> 

  let first = float_romberg_step_milne f a b

  and c = ( a +. b ) *. 0.5 in

   let second = ref ( float_romberg_step_milne f a c +. float_romberg_step_milne f c b ) in

    if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

     begin

      second := float_int_romberg_milne_bounded ( ( abs maxstages ) - 1 ) tol f a c

       +. float_int_romberg_milne_bounded ( ( abs maxstages ) - 1 ) tol f c b

     end ;

     !second ;;






(** 
§ 
 *)





(** The following vectors are coefficients to use with float_simple_step_gauss_kronrod_generic 
and to define float_romberg_step_gauss_kronrod.



Les vecteurs ci-dessous sont des coefficients pour float_simple_step_gauss_kronrod_generic 
et définissant float_romberg_step_gauss_kronrod. *)





(** 
 
 *)








let gauss_abscissae_7_bis = [| 0.949107912342759 ; 0.741531185599394 ; 0.405845151377397 ;  0. |] ;;



let gauss_weights_7_bis = [| 0.129484966168870 ; 0.279705391489277 ; 0.381830050505119 ; 0.417959183673469 |] ;;



let kronrod_abscissae_15_bis = [| 0.991455371120813 ; 0.949107912342759 ; 0.864864423359769 ; 

 0.741531185599394 ; 0.586087235467691 ; 0.405845151377397 ; 0.207784955007898 ; 0. |] ;;



let kronrod_weights_15_bis = [| 0.022935322010529 ; 0.063092092629979 ; 0.104790010322250 ; 0.140653259715525 ; 

 0.169004726639267 ; 0.190350578064785 ; 0.204432940075298 ; 0.209482141084728 |] ;;



let gauss_weights_7 = [| 0.129484966168869693270611432679082 ; 0.279705391489276667901467771423780 ;

 0.381830050505118944950369775488975 ; 0.417959183673469387755102040816327 |] ;;



let gauss_abscissae_7 = [| 0.949107912342758524526189684047851 ;

 0.741531185599394439863864773280788 ; 0.405845151377397166906606412076961 ; 0. |] ;;



let kronrod_abscissae_15 = [| 0.991455371120812639206854697526329 ; 0.949107912342758524526189684047851 ; 0.864864423359769072789712788640926 ;

 0.741531185599394439863864773280788 ; 0.586087235467691130294144838258730 ; 0.405845151377397166906606412076961 ; 0.207784955007898467600689403773245 ; 0.0 |] ;;



let kronrod_weights_15 = [| 0.022935322010529224963732008058970; 0.063092092629978553290700663189204 ;

 0.104790010322250183839876322541518 ; 0.140653259715525918745189590510238 ; 0.169004726639267902826583426598550 ;

 0.190350578064785409913256402421014 ; 0.204432940075298892414161999234649 ; 0.209482141084727828012999174891714 |] ;;



let gauss_kronrod_abscissae_7 = [| 0.960491 ; 0.774597 ; 0.434244 ; 0.000000 |] ;;



let gauss_kronrod_weights_7 = [| 0.104656 ; 0.268488 ; 0.401397 ; 0.450917 |] ;;



let gauss_kronrod_weights_5to7 = [| 0.0 ; 0.555556 ; 0.0 ; 0.888889 |] ;;



let gauss_kronrod_abscissae_9 = [| 0.976560 ; 0.861136 ; 0.640286 ; 0.339981 ; 0.0 |]



let gauss_kronrod_weights_9 = [| 0.062977 ; 0.170054 ; 0.266798 ; 0.326949 ; 0.346443 |] ;;



let gauss_kronrod_weights_7to9 = [| 0.0 ; 0.347855 ; 0.0 ; 0.652145 ; 0.0 |] ;;



let gauss_kronrod_abscissae_15 = [| 0.2077849550789850 ; 0.4058451513773972 ; 0.5860872354676911 ;

 0.7415311855993944 ; 0.8648644233597691 ; 0.9491079123427585 ; 0.9914553711208126 ; 0.0 |] ;;



let gauss_kronrod_weights_15 = [| 0.2044329400752989 ; 0.1903505780647854 ; 0.1690047266392679 ;

 0.1406532597155259 ; 0.1047900103222502 ; 0.06309209262997855 ; 0.02293532201052922 ; 0.2094821410847278 |] ;;



let gauss_kronrod_abscissae_21 = [| 0.99565716302580808073552728070 ; 0.97390652851717172007796401210 ;  0.93015749135570822600120718010 ; 

 0.86506336668898451073209668840 ; 0.78081772658641689706371757830 ; 0.67940956829902440623432736510 ; 0.56275713466860468333900009930 ;

 0.43339539412924719079926594320 ; 0.29439286270146019813112660310 ; 0.14887433898163121088482600110 ; 0.0 |] ;;



let gauss_kronrod_weights_21 = [| 0.11694638867371874278064396060e-1 ; 0.32558162307964727478818972460e-1 ; 0.54755896574351996031381300240e-1 ; 

 0.75039674810919952767043140920e-1 ; 0.93125454583697605535065465080e-1 ; 0.10938715880229764189921059030 ; 0.12349197626206585107795810980 ; 

 0.13470921731147332592805400180 ; 0.14277593857706008079709427310 ; 0.14773910490133849137484151600 ; 0.14944555400291690566493646840 |] ;;



let gauss_kronrod_weights_11to21 = [| 0. ; 0.66671344308688137593568809890e-1 ; 0. ; 0.14945134915058059314577633970 ; 0. ; 

 0.21908636251598204399553493420 ; 0. ; 0.26926671930999635509122692160 ; 0. ; 0.29552422471475287017389299470 |] ;;



let gauss_kronrod_abscissae_31 = [| 0.1011420669187175 ; 0.2011940939974345 ; 0.2991800071531688 ; 0.3941513470775634 ; 

0.4850818636402397 ; 0.5709721726085388 ; 0.6509967412974170 ; 0.7244177313601700 ; 0.7904185014424659 ; 0.8482065834104272 ;

 0.8972645323440819 ; 0.9372733924007059 ; 0.9677390756791391 ; 0.9879925180204854 ; 0.9980022986933971 ; 0.0 |] ;;



let gauss_kronrod_weights_31 = [| 0.1007698455238756 ; 0.09917359872179196 ; 0.09664272698362368 ; 0.09312659817082532 ;

 0.08856444305621177 ; 0.08308050282313302 ; 0.07684968075772038 ; 0.06985412131872826 ; 0.06200956780067064 ; 0.05348152469092809 ;

 0.04458975132476488 ; 0.03534636079137585 ; 0.02546084732671532 ; 0.01500794732931612 ; 0.05377479872923349 ; 0.001013300070147915 |] ;;



let gauss_kronrod_abscissae_41 = [| 0.07652652113349733 ; 0.1526054652409227 ; 0.2277858511416451 ; 0.3016278681149130 ;

 0.3737060887154196 ; 0.4435931752387251 ; 0.5108670019508271 ; 0.5751404468197103 ; 0.6360536807265150 ; 0.6932376563347514 ;

 0.7463319064601508 ; 0.7950414288375512 ; 0.8391169718222188 ; 0.8782768112522820 ; 0.9122344282513259 ; 0.9408226338317548 ;

 0.9639719272779138 ; 0.9815078774502503 ; 0.9931285991850949 ; 0.9988590315882777 ; 0.0 |] ;;



let gauss_kronrod_weights_41 = [| 0.07637786767208074 ; 0.07570449768455667 ; 0.07458287540049919 ; 0.07303069033278667 ;

 0.07105442355344407 ; 0.06864867292852162 ; 0.06583459713361842 ; 0.06265323755478117 ; 0.05911140088063957 ; 0.05519510534828599 ;

 0.05094457392372869 ; 0.04643482186749767 ; 0.04166887332797369 ; 0.03660016975820080 ; 0.03128730677703280 ; 0.02588213360495116 ;

 0.02038837346126652 ; 0.01462616925697125 ; 0.008600269855642942 ; 0.003073583718520532 ; 0.07660071191799966 |] ;;






(** 
§ 
 *)







(** 
float_romberg_step_gauss_kronrod function a b
 The data come from the source code of scilab, 
which quotes quadpack.



Les données proviennent du cose source de scilab, qui cite quadpack. *)


let float_romberg_step_gauss_kronrod = fun (f:float -> float) (a:float) (b:float) ->

 let x = gauss_kronrod_abscissae_21

 and w = gauss_kronrod_weights_21

 and ww = gauss_kronrod_weights_11to21

 and delta = ref 0.

 and valueplus = ref 0.

 and valueminus = ref 0.

 and halflength = ( b -. a ) *. 0.5

 and c = ( a +. b ) *. 0.5

 and accumul = ref 0. in

  let accu = ref ( w.(10) *. f c ) in

   for i = 0 to 9 do

    delta := halflength *. x.(i) ;

    valueplus := f ( c +. !delta ) ;

    valueminus := f ( c -. !delta ) ;

    accu := !accu +. w.(i) *. !valueplus ;

    accu := !accu +. w.(i) *. !valueminus ;

    accumul := !accumul +. ww.(i) *. !valueplus ;

    accumul := !accumul +. ww.(i) *. !valueminus ;

   done ;

   [| halflength *. !accu ; halflength *. !accumul |] ;;






(** 
float_simple_step_gauss_kronrod_generic abscissae weights function a b
  *)


let float_simple_step_gauss_kronrod_generic = fun (x:float array) (w:float array) (f:float -> float) (a:float) (b:float) ->

 let ll = ( Array.length w ) - 1

 and delta = ref 0.

 and valueplus = ref 0.

 and valueminus = ref 0.

 and halflength = ( b -. a ) *. 0.5

 and c = ( a +. b ) *. 0.5 in

  let accu = ref ( w.(ll) *. f c ) in

   for i = 0 to ll - 1 do

    delta := halflength *. x.(i) ;

    valueplus := f ( c +. !delta ) ;

    valueminus := f ( c -. !delta ) ;

    accu := !accu +. w.(i) *. !valueplus ;

    accu := !accu +. w.(i) *. !valueminus ;

   done ;

   halflength *. !accu ;;






(** 
float_simple_step_gauss_kronrod function a b
 *)


let float_simple_step_gauss_kronrod = fun (f:float -> float) (a:float) (b:float) ->

 ( float_romberg_step_gauss_kronrod f a b ).(0) ;;




(** 
float_int_romberg_gauss_kronrod_adapt tolerance function a b
 *)


let rec float_int_romberg_gauss_kronrod_adapt = fun (tol:float) (f:float -> float) (a:float) (b:float) ->

 let first = float_romberg_step_gauss_kronrod f a b in

  if abs_float ( first.(0) -. first.(1) ) < tol *. abs_float ( first.(0) )

   then first.(0)

  else let c = ( a +. b ) *. 0.5 in

   ( float_int_romberg_gauss_kronrod_adapt tol f a c ) +. ( float_int_romberg_gauss_kronrod_adapt tol f c b ) ;;




(** 
float_int_romberg_gauss_kronrod_bounded maxstages tolerance function a b
 *)


let rec float_int_romberg_gauss_kronrod_bounded = fun (maxstages:int) (tol:float) (f:float -> float) (a:float) (b:float) ->

 match maxstages with 

 | 0 -> float_simple_step_gauss_kronrod f a b

 | _ -> 

 let first = float_romberg_step_gauss_kronrod f a b in

  if abs_float ( first.(0) -. first.(1) ) < tol *. abs_float ( first.(0) )

   then first.(0)

  else let c = ( a +. b ) *. 0.5 in

   ( float_int_romberg_gauss_kronrod_bounded ( ( abs maxstages ) - 1 ) tol f a c )

    +. ( float_int_romberg_gauss_kronrod_bounded ( ( abs maxstages ) - 1 ) tol f c b ) ;;






(** 
float_int_tanh nintervals function a b
 *)


let float_int_tanh = fun (n:int) (f:float -> float) (a:float) (b:float) ->

 let nnn = float n

 and halflength = 0.5 *. ( b -. a )

 and center = 0.5 *. ( a +. b ) in

  let h = halfpi *. sqrt ( 2. /. nnn ) -. ( 1. /. nnn )

  and accu = ref 0.

  and nn = 2 * n + 1 in

   let x = Array.mapi ( fun i z -> tanh ( ( float ( i - n ) ) *. h ) ) ( Array.make nn 0. ) in

    let w = Matrix.vector_float_scal_mult h ( Matrix.vector_float_scal_right_sub 1. ( Matrix.vector_float_coeff_prod x x ) ) in

     for i = 0 to nn - 1 do

      accu := !accu +. w.(i) *. ( f ( center +. halflength *. x.(i) ) ) ;

     done ;

     !accu *. halflength ;;






(** 
float_int_tanh_sinh parameter function a b
 *)


let float_int_tanh_sinh = fun (m:int) (f:float -> float) (a:float) (b:float) ->

 let mm = float m

 and halflength = 0.5 *. ( b -. a )

 and center = 0.5 *. ( a +. b ) in

  let coeff = 2. ** mm in

   let n = 8 * ( int_of_float coeff )

   and h = 1. /. coeff

   and accu = ref 0. in

    let nn = 2 * n + 1 in

     let x = Array.mapi ( fun i z -> tanh ( halfpi *. sinh ( ( float ( i - n ) ) *. h ) ) ) ( Array.make nn 0. )

     and xx = Array.mapi ( fun i z -> cosh ( ( float ( i - n ) ) *. h ) ) ( Array.make nn 0. ) in

      let w = Matrix.vector_float_coeff_prod xx ( Matrix.vector_float_scal_mult ( h *. halfpi ) ( Matrix.vector_float_scal_right_sub 1. ( Matrix.vector_float_coeff_prod x x ) ) ) in

       for i = 0 to nn - 1 do

        accu := !accu +. w.(i) *. ( f ( center +. halflength *. x.(i) ) ) ;

       done ;

       !accu *. halflength ;;






(** 
§ 
 *)





(** The following vectors are used to calculate the float_weighted_int_0_1 method of integration.



Les vecteurs suivants servent à calculer la méthode d'intégration float_weighted_int_0_1. *)





(** 
 
 *)






let adams_bashforth_1_w = [| 1. |] ;;



let adams_bashforth_2_w = Matrix.vector_float_scal_left_div 2. [| 3. ; -1. |] ;;



let adams_bashforth_3_w = Matrix.vector_float_scal_left_div 12. [| 23. ; -16. ; 5. |] ;;



let adams_bashforth_4_w = Matrix.vector_float_scal_left_div 24. [| 55. ; -59. ; 37. ; -9. |] ;;



let adams_bashforth_5_w = Matrix.vector_float_scal_left_div 720. [| 1901. ; -2774. ; 2616. ; -1274. ; 251. |] ;;



let adams_bashforth_6_w = Matrix.vector_float_scal_left_div 1440. [| 4277. ; -7923. ; 9982. ; -7298. ; 2877. ; -475. |] ;;



let adams_bashforth_7_w = Matrix.vector_float_scal_left_div 60480. [| 198721. ; -447288. ; 705549. ; -688256. ; 407139. ; -134472. ; 19087. |] ;;



let adams_bashforth_8_w = Matrix.vector_float_scal_left_div 120960. [| 434241. ; -1152169. ; 2183877. ; -2664477. ; 2102243. ; -1041723. ; 295767. ; -36799. |] ;;



let adams_bashforth_9_w = Matrix.vector_float_scal_left_div 3628800. [| 14097247. ; -43125206. ;

 95476786. ; -139855262. ; 137968480. ; -91172642. ; 38833486. ; -9664106. ; 1070017. |] ;;



let adams_bashforth_10_w = Matrix.vector_float_scal_left_div 7257600. [| 30277247. ; -104995189. ; 265932680. ; -454661776. ; 538363838. ;

 -444772162. ; 252618224. ; -94307320. ; 20884811. ; -2082753. |] ;;



let adams_bashforth_12_w = Matrix.vector_float_scal_left_div 958003200. [| 4527766399. ; -19433810163. ; 61633227185. ; -135579356757. ;

 214139355366. ; -247741639374. ; 211103573298. ; -131365867290. ; 58189107627. ; -17410248271. ; 3158642445. ; -262747265. |] ;;



let adams_bashforth_14_w = Matrix.vector_float_scal_left_div 5230697472e3 [| 27511554976875. ; -140970750679621. ; 537247052515662. ; -1445313351681906. ; 2854429571790805. ; -4246767353305755. ; 4825671323488452. ;

 -4204551925534524. ; 2793869602879077. ; -1393306307155755. ; 505586141196430. ; -126174972681906. ; 19382853593787. ; -1382741929621. |] ;;



let adams_bashforth_16_w = Matrix.vector_float_scal_left_div 62768369664e3 [| 362555126427073. ; -2161567671248849. ; 9622096909515337. ;

 -30607373860520569. ; 72558117072259733. ; -131963191940828581. ; 187463140112902893. ; -210020588912321949. ; 186087544263596643. ;

 -129930094104237331. ; 70724351582843483. ; -29417910911251819. ; 9038571752734087. ; -1934443196892599. ; 257650275915823. ; -16088129229375.  |] ;;



let adams_bashforth_18_w = Matrix.vector_float_scal_left_div 6402373705728e4 [| 401972381695456831. ; -2735437642844079789. ; 13930159965811142228. ; 

 -51150187791975812900. ; 141500575026572531760. ; -304188128232928718008. ; 518600355541383671092. ; -710171024091234303204. ; 

 786600875277595877750. ; -706174326992944287370. ; 512538584122114046748. ; -298477260353977522892. ; 137563142659866897224. ;

 -49070094880794267600. ; 13071639236569712860. ; -2448689255584545196. ; 287848942064256339. ; -15980174332775873. |] ;;



let adams_bashforth_20_w = Matrix.vector_float_scal_left_div 10218188434341888e4 [| 691668239157222107697. ; -5292843584961252933125. ;

 30349492858024727686755. ; -126346544855927856134295. ; 399537307669842150996468. ; -991168450545135070835076. ; 1971629028083798845750380. ;

 -3191065388846318679544380. ; 4241614331208149947151790. ; -4654326468801478894406214. ; 4222756879776354065593786. ; -3161821089800186539248210. ;

 1943018818982002395655620. ; -970350191086531368649620. ; 387739787034699092364924. ; -121059601023985433003532. ; 28462032496476316665705. ;

 -4740335757093710713245. ; 498669220956647866875. ; -24919383499187492303. |] ;;





let adams_bashforth_m = Array.map Util.reverse_array [| adams_bashforth_1_w ; adams_bashforth_2_w ; adams_bashforth_3_w ; adams_bashforth_4_w ; adams_bashforth_5_w ;

 adams_bashforth_6_w ; adams_bashforth_7_w ; adams_bashforth_8_w ; adams_bashforth_9_w ; adams_bashforth_10_w ; Array.append adams_bashforth_10_w [| 0. |] ; 

 adams_bashforth_12_w ; Array.append adams_bashforth_12_w [| 0. |] ; adams_bashforth_14_w ; Array.append adams_bashforth_14_w [| 0. |] ;

 adams_bashforth_16_w ; Array.append adams_bashforth_16_w [| 0. |] ; adams_bashforth_18_w ; Array.append adams_bashforth_18_w [| 0. |] ; adams_bashforth_20_w |] ;;





let adams_bashforth_x = function (n:int) -> Matrix.float_closed_equal_subdivision 1. n 0. ;;





let adams_moulton_x = adams_bashforth_x ;;





let adams_moulton_1_w = [| 1.0 |] ;;



let adams_moulton_2_w = Matrix.vector_float_scal_left_div 2.0 [| 1.0 ; 1.0 |] ;;



let adams_moulton_3_w = Matrix.vector_float_scal_left_div 12.0 

 [| 5.0 ; 8.0 ; - 1.0 |] ;;



let adams_moulton_4_w = Matrix.vector_float_scal_left_div 24.0 

 [| 9.0 ; 19.0 ; - 5.0 ; 1.0 |] ;;



let adams_moulton_5_w = Matrix.vector_float_scal_left_div 720.0 

 [| 251.0 ; 646.0 ; - 264.0 ; 106.0 ; - 19.0 |] ;;



let adams_moulton_6_w = Matrix.vector_float_scal_left_div 1440.0 

 [| 475.0 ; 1427.0 ; - 798.0 ; 482.0 ; - 173.0 ; 27.0 |] ;;



let adams_moulton_7_w = Matrix.vector_float_scal_left_div 60480.0 

 [| 19087.0 ; 65112.0 ; - 46461.0 ; 37504.0 ; - 20211.0 ; 6312.0 ; - 863.0 |] ;;



let adams_moulton_8_w = Matrix.vector_float_scal_left_div 120960.0 

 [| 36799.0 ; 139849.0 ; - 121797.0 ; 123133.0 ; - 88547.0 ; 41499.0 ; - 11351.0 ; 1375.0 |] ;;



let adams_moulton_9_w = Matrix.vector_float_scal_left_div 3628800.0 

[| 1070017.0 ; 4467094.0 ; - 4604594.0 ; 5595358.0 ; - 5033120.0 ; 3146338.0 ; - 1291214.0 ; 312874.0 ; - 33953.0 |] ;;



let adams_moulton_10_w = Matrix.vector_float_scal_left_div 7257600.0 

 [| 2082753.0 ; 9449717.0 ; - 11271304.0 ; 16002320.0 ; - 17283646.0 ; 13510082.0 ; - 7394032.0 ; 2687864.0 ; - 583435.0 ; 57281.0 |] ;;



let adams_moulton_12_w = Matrix.vector_float_scal_left_div 958003200.0 

 [| 262747265.0 ; 1374799219.0 ; -2092490673.0 ; 3828828885.0 ; -5519460582.0 ;

 6043521486.0 ; -4963166514.0 ; 3007739418.0 ; -1305971115.0 ; 384709327.0 ; -68928781.0 ; 5675265.0 |] ;;



let adams_moulton_14_w = Matrix.vector_float_scal_left_div 5230697472000.0 

 [| 1382741929621.0 ; 8153167962181.0 ; -15141235084110.0 ; 33928990133618.0 ; -61188680131285.0 ; 86180228689563.0 ;

 -94393338653892.0 ; 80101021029180.0 ; -52177910882661.0 ; 25620259777835.0 ; -9181635605134.0 ; 2268078814386.0 ; -345457086395.0 ; 24466579093.0 |] ;;



let adams_moulton_16_w = Matrix.vector_float_scal_left_div 62768369664000.0 

[| 16088129229375.0 ; 105145058757073.0 ; -230992163723849.0 ; 612744541065337.0 ; -1326978663058069.0 ; 2285168598349733.0 ;

 -3129453071993581.0 ; 3414941728852893.0 ; -2966365730265699.0 ; 2039345879546643.0 ; -1096355235402331.0 ; 451403108933483.0 ; -137515713789319.0 ;

 29219384284087.0 ; -3867689367599.0 ; 240208245823.0 |] ;;

 

let adams_moulton_18_w = Matrix.vector_float_scal_left_div 64023737057280000.0 

[| 15980174332775873.0 ; 114329243705491117.0 ; -290470969929371220.0 ; 890337710266029860.0 ; -2250854333681641520.0 ;

 4582441343348851896.0 ; -7532171919277411636.0 ; 10047287575124288740.0 ; -10910555637627652470.0 ; 9644799218032932490.0 ; -6913858539337636636.0 ;

 3985516155854664396.0 ; -1821304040326216520.0 ; 645008976643217360.0 ; -170761422500096220.0 ; 31816981024600492.0 ; -3722582669836627.0 ;

 205804074290625.0 |] ;;



let adams_moulton_20_w = Matrix.vector_float_scal_left_div 102181884343418880000.0

[| 24919383499187492303.0 ; 193280569173472261637.0 ; -558160720115629395555.0 ; 1941395668950986461335.0 ; -5612131802364455926260.0 ;

 13187185898439270330756.0 ; -25293146116627869170796.0 ; 39878419226784442421820.0 ; -51970649453670274135470.0 ; 56154678684618739939910.0 ;

 -50320851025594566473146.0 ; 37297227252822858381906.0 ; -22726350407538133839300.0 ; 11268210124987992327060.0 ; -4474886658024166985340.0 ;

 1389665263296211699212.0 ; -325187970422032795497.0 ; 53935307402575440285.0 ; -5652892248087175675.0 ; 281550972898020815.0 |] ;;





let gauss_legendre_0_1_1_x = [| 0.5 |] ;;



let gauss_legendre_0_1_1_w = [| 1. |] ;;



let gauss_legendre_0_1_2_x = [| 0.5 -. sqrt_of_3 /. 6. ; 0.5 +. sqrt_of_3 /. 6. |]


(** | 0.2113248654 ; 0.7886751346 | *)
 ;;



let gauss_legendre_0_1_2_w = [| 0.5 ; 0.5 |] ;;



let gauss_legendre_0_1_3_x = [| 0.5 -. 0.1 *. ( sqrt_of_15 ) ; 0.5 ; 0.5 +. 0.1 *. ( sqrt_of_15 ) |]


(** | 0.1127016654 ; 0.5 ; 0.887298334 | *)
 ;;



let gauss_legendre_0_1_3_w = [| 5. /. 18. ; 8. /. 18. ; 5. /. 18. |] ;;



let gauss_legendre_0_1_4_x = [| 0.0694318442 ; 0.3300094782 ; 0.6699905218 ; 0.9305681558 |] ;;



let gauss_legendre_0_1_4_w = [| 0.1739274226 ; 0.3260725774 ; 0.3260725774 ; 0.1739274226 |] ;;



let gauss_legendre_0_1_5_x = [| 0.0469100770 ; 0.2307653449 ; 0.5 ; 0.7692346551 ; 0.9530899230 |] ;;



let gauss_legendre_0_1_5_w = [| 0.1184634425 ; 0.2393143352 ; 0.2844444444 ; 0.2393143352 ; 0.1184634425 |] ;;



let gauss_legendre_0_1_6_x = [| 0.0337652429 ; 0.1693953068 ; 0.3806904070 ; 0.6193095930 ; 0.8306046932 ; 0.9662347571 |] ;;



let gauss_legendre_0_1_6_w = [| 0.0856622462 ; 0.1803807865 ; 0.2339569673 ; 0.2339569673 ; 0.1803807865 ; 0.0856622462 |] ;;



let gauss_legendre_0_1_7_x = [| 0.0254460438 ; 0.1292344072 ; 0.2970774243 ; 0.5000000000 ; 0.7029225757 ; 0.8707655928 ; 0.9745539562 |] ;;



let gauss_legendre_0_1_7_w = [| 0.0647424831 ; 0.1398526957 ; 0.1909150253 ; 0.2089795918 ; 0.1909150253 ; 0.1398526957 ; 0.0647424831 |] ;;



let gauss_legendre_0_1_8_x = [| 0.0198550718 ; 0.1016667613 ; 0.2372337950 ; 0.4082826788 ; 0.5917173212 ; 0.7627662050 ; 0.8983332387 ; 0.9801449282 |] ;;



let gauss_legendre_0_1_8_w = [| 0.0506142681 ; 0.1111905172 ; 0.1568533229 ; 0.1813418917 ; 0.1813418917 ; 0.1568533229 ; 0.1111905172 ; 0.0506142681 |] ;;








(** 
 
 *)









(** 
float_weighted_int_0_1 abscissae weights function
 The standard abscissae are spread over the interval [0 ; 1].



Les abscisses normalisées sont réparties sur l'interavlle [0 ; 1]. *)


let float_weighted_int_0_1 = fun (x:float array) (w:float array) (f:float -> float) ->

 let l = Array.length x

 and accu = ref 0. in

  for i = 0 to l - 1 do

   accu := !accu +. w.(i) *. ( f x.(i) ) ;

  done ;

  !accu ;;








(** 
§ 
 *)





(** The following vectors are used to calculate the float_weighted_int_minus1_1 method of integration.



Les vecteurs suivants servent à calculer la méthode d'intégration float_weighted_int_minus1_1. *)





(** 
 
 *)










let clenshaw_curtis_1_x = [| 0. |] ;;



let clenshaw_curtis_1_w = [| 2. |] ;;





let clenshaw_curtis_2_x = [| -1. ; 1. |] ;;



let clenshaw_curtis_2_w = [| 1. ; 1. |] ;;





let clenshaw_curtis_3_x = [| -1. ; 0. ; 1. |] ;;



let clenshaw_curtis_3_w = [| 1. /. 3. ; 4. /. 3. ; 1. /. 3. |] ;;





let clenshaw_curtis_4_x = [| -1. ; -0.5 ; 0.5 ; 1. |] ;;



let clenshaw_curtis_4_w = [| 1. /. 9. ; 8. /. 9. ; 8. /. 9. ; 1. /. 9. ; |] ;;





let clenshaw_curtis_x_5_x = [| -1. ; -0.70710678118654752440 ; 0. ; 0.70710678118654752440 ; 1. |] ;;



let clenshaw_curtis_5_w = [| 0.06666666666666666667 ; 0.53333333333333333333 ; 0.80000000000000000000 ; 0.53333333333333333333 ; 0.06666666666666666667 |] ;;





let clenshaw_curtis_6_x = [| -1. ; -0.80901699437494742410 ; -0.30901699437494742410 ; 0.30901699437494742410 ; 0.80901699437493732410 ; 1. |] ;;



let clenshaw_curtis_6_w = [| 0.04 ; 0.36074304120001121619 ; 0.59925695879998878381 ; 0.59925695879998878381 ; 0.36074304120001121619 ; 0.04 |] ;;





let clenshaw_curtis_7_x = [| -1. ; -0.86602540378443864676 ; -0.5 ; 0. ; 0.5 ; 0.86602540378443864676 ; 1. |] ;;



let clenshaw_curtis_7_w = [| 0.02857142857142857143 ; 0.25396825396825396825 ; 0.45714285714285714286 ;

 0.52063492063492063492 ; 0.45714285714285714286 ; 0.25396825396825396825 ; 0.02857142857142857143 |] ;;





let clenshaw_curtis_8_x = [| -1. ; -0.90096886790241912624 ; -0.62348980185873353053 ; -0.22252093395631440429 ;

 0.22252093395631440429 ; 0.62348980185873353053 ; 0.90096886790241910624 ; 1. |] ;;



let clenshaw_curtis_8_w = [| 0.02040816326530612245 ; 0.19014100721820835178 ; 0.35224242371815911533 ; 0.43720840579832641044 ;

 0.43720840579832641044 ; 0.35224242371815911533 ; 0.19014100721820835178 ; 0.02040816326530612245 |] ;;





let clenshaw_curtis_9_x = [| -1. ; -0.92387953251128675613 ; -0.70710678118654752440 ; -0.38268343236508977173 ; 0.00000000000000000000 ;

 0.38268343236508977173 ; 0.70710678118654752440 ; 0.92387953251128675613 ; 1. |] ;;



let clenshaw_curtis_9_w = [| 0.01587301587301587302 ; 0.14621864921601815501 ; 0.27936507936507936508 ; 0.36171785872048978150 ;

 0.39365079365079365079 ; 0.36171785872048978150 ; 0.27936507936507936508 ; 0.14621864921601815501 ; 0.01587301587301587302 |] ;;





let clenshaw_curtis_10_x = [| -1. ; -0.93969262078590838405 ; -0.76604444311897903520 ; -0.50000000000000000000 ; -0.17364817766693034885 ;

 0.17364817766693034885 ; 0.50000000000000000000 ; 0.76604444311897903520 ; 0.93969262078590838405 ; 1. |] ;;



let clenshaw_curtis_10_w = [| 0.01234567901234567901 ; 0.11656745657203712296 ; 0.22528432333810440813 ; 0.30194003527336860670 ; 0.34386250580414418320 ;

 0.34386250580414418320 ; 0.30194003527336860670 ; 0.22528432333810440813 ; 0.11656745657203712296 ; 0.01234567901234567901 |] ;;





let clenshaw_curtis_11_x = [| -1. ; -0.95105651629515357212 ; -0.80901699437494742410 ; -0.58778525229247312917 ; -0.30901699437494742410 ; 0. ;

 0.30901699437494742410 ; 0.58778525229247312917 ; 0.80901699437494742410 ; 0.95105651629515357212 ; 1. |] ;;



let clenshaw_curtis_11_w = [| 0.01010101010101010101 ; 0.09457905488370156116 ; 0.18563521442424776529 ; 0.25358833328368660623 ; 0.29921327042423708320 ;

 0.31376623376623376623 ; 0.29921327042423708320 ; 0.25358833328368660623 ; 0.18563521442424776529 ; 0.09457905488370156116 ; 0.01010101010101010101 |] ;;





let clenshaw_curtis_12_x = [| -1. ; -0.95949297361449738989 ; -0.84125353283118116886 ; -0.65486073394528506406 ; -0.41541501300188642553 ;

 -0.14231483827328514044 ; 0.14231483827328514044 ; 0.41541501300188642553 ; 0.65486073394528506406 ; 0.84125353283118116886 ; 0.95949297361449738989 ; 1. |] ;;



let clenshaw_curtis_12_w = [| 0.00826446280991735537 ; 0.07856015374620000543 ; 0.15504045508256136552 ; 0.21556254600086858099 ;

 0.25991734106691617602 ; 0.28265504129353651666 ; 0.28265504129353651666 ; 0.25991734106691617602 ; 0.21556254600086858099 ;

 0.15504045508256136552 ; 0.07856015374620000543 ; 0.00826446280991735537 |] ;;





let clenshaw_curtis_13_x = [| -1. ; -0.96592582628906828675 ; -0.86602540378443864676 ; -0.70710678118654752440 ; -0.5 ; -0.25881904510252076235 ;

 0.0 ; 0.25881904510252076235 ; 0.5 ; 0.70710678118654752440 ; 0.86602540378443864676 ; 0.96592582628906828675 ; 1. |] ;;



let clenshaw_curtis_13_w = [| 0.00699300699300699301 ; 0.06605742495207439452 ; 0.13154253154253154253 ; 0.18476338476338476338 ;

 0.22697302697302697303 ; 0.25267569378104433860 ; 0.26198986198986198986 ; 0.25267569378104433860 ; 0.22697302697302697303 ;

 0.18476338476338476338 ; 0.13154253154253154253 ; 0.06605742495207439452 ; 0.00699300699300699301 |] ;;





let clenshaw_curtis_14_x = [| -1. ; -0.97094181742605202716 ; -0.88545602565320989590 ; -0.74851074817110109863 ; -0.56806474673115580251 ;

 -0.35460488704253562597 ; -0.12053668025532305335 ;  0.12053668025532305335 ;  0.35460488704253562597 ;  0.56806474673115580251 ;

  0.74851074817110109863 ;  0.88545602565320989590 ; 0.97094181742605202716 ; 1. |] ;;



let clenshaw_curtis_14_w = [| 0.00591715976331360947 ; 0.05646531376341444627 ; 0.11276867248985655881 ; 0.16003802611671868523 ;

 0.19899241036578321848 ; 0.22590304977856444935 ; 0.23991536772234903239 ; 0.23991536772234903239 ; 0.22590304977856444935 ;

 0.19899241036578321848 ; 0.16003802611671868523 ; 0.11276867248985655881 ; 0.05646531376341444627 ; 0.00591715976331360947 |] ;;





let clenshaw_curtis_15_x = [| -1. ; -0.97492791218182360702 ; -0.90096886790241912624 ; -0.78183148246802980871 ; -0.62348980185873353053 ;

 -0.43388373911755812048 ; -0.22252093395631440429 ;  0. ;  0.22252093395631440429 ;  0.43388373911755812048 ;  0.62348980185873353053 ;

  0.78183148246802980871 ;  0.90096886790241912624 ; 0.97492791218182360702 ; 1. |] ;;



let clenshaw_curtis_15_w = [| 0.00512820512820512821 ; 0.04869938729508823855 ; 0.09782039167605215913 ; 0.13966507849560431803 ;

 0.17560578900106674677 ; 0.20205146748238357364 ; 0.21888151163057340180 ; 0.22429633858205286777 ; 0.21888151163057340180 ;

 0.20205146748238357364 ; 0.17560578900106674677 ; 0.13966507849560431803 ; 0.09782039167605215913 ; 0.04869938729508823855 ; 0.00512820512820512821 |] ;;





let clenshaw_curtis_16_x = [| -1. ; -0.97814760073380563793 ; -0.91354545764260089550 ; -0.80901699437494742410 ; -0.66913060635885821383 ;

 -0.5 ; -0.30901699437494742410 ; -0.10452846326765347140 ;  0.10452846326765347140 ;  0.30901699437494742410 ;  0.5 ;  0.66913060635885821383 ;

  0.80901699437494742410 ;  0.91354545764260089550 ;  0.97814760073380563793 ; 1. |] ;;



let clenshaw_curtis_16_w = [| 0.00444444444444444444 ; 0.04251476624752508988 ; 0.08553884025933288291 ; 0.12294010082849361533 ;

 0.15573317603967369176 ; 0.18132978132978132978 ; 0.19921478132638853955 ; 0.20828410952436040635 ; 0.20828410952436040635 ;

 0.19921478132638853955 ; 0.18132978132978132978 ; 0.15573317603967369176 ; 0.12294010082849361533 ; 0.08553884025933288291 ;

 0.04251476624752508988 ; 0.00444444444444444444 |] ;;





let clenshaw_curtis_17_x = [| -1. ; -0.98078528040323044913 ; -0.92387953251128675613 ; -0.83146961230254523708 ; -0.70710678118654752440 ;

 -0.55557023301960222474 ; -0.38268343236508977173 ; -0.19509032201612826785 ;  0. ;  0.19509032201612826785 ;  0.38268343236508977173 ;

  0.55557023301960222474 ;  0.70710678118654752440 ;  0.83146961230254523708 ;  0.92387953251128675613 ;  0.98078528040323044913 ; 1. |] ;;



let clenshaw_curtis_17_w = [| 0.00392156862745098039 ; 0.03736870283720561032 ; 0.07548233154315183441 ; 0.10890555258189093044 ;

 0.13895646836823307412 ; 0.16317266428170330256 ; 0.18147378423649335700 ; 0.19251386461292564687 ; 0.19641012582189052777 ;

 0.19251386461292564687 ; 0.18147378423649335700 ; 0.16317266428170330256 ; 0.13895646836823307412 ; 0.10890555258189093044 ;

 0.07548233154315183441 ; 0.03736870283720561032 ; 0.00392156862745098039 |] ;;





let clenshaw_curtis_33_x = [| -1. ; -0.99518472667219688624 ; -0.98078528040323044913 ; -0.95694033573220886494 ; -0.92387953251128675613 ;

 -0.88192126434835502971 ; -0.83146961230254523708 ; -0.77301045336273696081 ; -0.70710678118654752440 ; -0.63439328416364549822 ;

 -0.55557023301960222474 ; -0.47139673682599764856 ; -0.38268343236508977173 ; -0.29028467725446236764 ; -0.19509032201612826785 ;

 -0.098017140329560601994 ; 0. ; 0.098017140329560601994 ; 0.19509032201612826785 ; 0.29028467725446236764 ; 0.38268343236508977173 ;

 0.47139673682599764856 ; 0.55557023301960222474 ; 0.63439328416364549822 ; 0.70710678118654752440 ; 0.77301045336273696081 ;

 0.83146961230254523708 ; 0.88192126434835502971 ; 0.92387953251128675613 ; 0.95694033573220886494 ; 0.98078528040323044913 ; 0.99518472667219688624 ; 1. |] ;;



let clenshaw_curtis_33_w = [| 0.00097751710654936461 ; 0.00939319796295501470 ; 0.01923424513268114918 ; 0.02845791667723369009 ;

 0.03759434191404720602 ; 0.04626276283775174949 ; 0.05455501630398031044 ; 0.06227210954529400455 ; 0.06942757563043545090 ;

 0.07588380044138847048 ; 0.08163481765493851023 ; 0.08657753844182743544 ; 0.09070611286772099874 ; 0.09394324443876873573 ;

 0.09629232594548817919 ; 0.09769818820805558182 ; 0.09817857778176829677 ; 0.09769818820805558182 ; 0.09629232594548817919 ;

 0.09394324443876873573 ; 0.09070611286772099874 ; 0.08657753844182743544 ; 0.08163481765493851023 ; 0.07588380044138847048 ;

 0.06942757563043545090 ; 0.06227210954529400455 ; 0.05455501630398031044 ; 0.04626276283775174949 ; 0.03759434191404720602 ;

 0.02845791667723369009 ; 0.01923424513268114918 ; 0.00939319796295501470 ; 0.00097751710654936461 |] ;;





let clenshaw_curtis_65_x = [| -1. ; -0.99879545620517239271 ; -0.99518472667219688624 ; -0.98917650996478097345 ; -0.98078528040323044913 ;

 -0.97003125319454399260 ; -0.95694033573220886494 ; -0.94154406518302077841 ; -0.92387953251128675613 ; -0.90398929312344333159 ;

 -0.88192126434835502971 ; -0.85772861000027206990 ; -0.83146961230254523708 ; -0.80320753148064490981 ; -0.77301045336273696081 ;

 -0.74095112535495909118 ; -0.70710678118654752440 ; -0.67155895484701840063 ; -0.63439328416364549822 ; -0.59569930449243334347 ;

 -0.55557023301960222474 ; -0.51410274419322172659 ; -0.47139673682599764856 ; -0.42755509343028209432 ; -0.38268343236508977173 ;

 -0.33688985339222005069 ; -0.29028467725446236764 ; -0.24298017990326388995 ; -0.19509032201612826785 ; -0.14673047445536175166 ;

 -0.098017140329560601994 ; -0.049067674327418014255 ; 0. ; 0.049067674327418014255 ; 0.098017140329560601994 ;

 0.14673047445536175166 ; 0.19509032201612826785 ; 0.24298017990326388995 ; 0.29028467725446236764 ; 0.33688985339222005069 ;

 0.38268343236508977173 ; 0.42755509343028209432 ; 0.47139673682599764856 ; 0.51410274419322172659 ; 0.55557023301960222474 ;

 0.59569930449243334347 ; 0.63439328416364549822 ; 0.67155895484701840063 ; 0.70710678118654752440 ; 0.74095112535495909118 ;

 0.77301045336273696081 ; 0.80320753148064490981 ; 0.83146961230254523708 ; 0.85772861000027206990 ; 0.88192126434835502971 ;

 0.90398929312344333159 ; 0.92387953251128675613 ; 0.94154406518302077841 ; 0.95694033573220886494 ; 0.97003125319454399260 ;

 0.98078528040323044913 ; 0.98917650996478097345 ; 0.99518472667219688624 ; 0.99879545620517239271 ; 1. |] ;;



let clenshaw_curtis_65_w = [| 0.00024420024420024420 ; 0.00235149067531170332 ; 0.00483146544879091264 ; 0.00719269316173611402 ;

 0.00958233879528379039 ; 0.01192339471421277160 ; 0.01425206043235199679 ; 0.01653498765728958965 ; 0.01878652974179578354 ;

 0.02098627442973743378 ; 0.02314069493435819848 ; 0.02523506498175476590 ; 0.02727225714146838686 ; 0.02924065319746833770 ;

 0.03114129710406762447 ; 0.03296454656997632997 ; 0.03471049818092511427 ; 0.03637092028663918309 ; 0.03794545992128481711 ;

 0.03942698871295609976 ; 0.04081501340035783384 ; 0.04210333111141810203 ; 0.04329151496169082935 ; 0.04437417923925731580 ;

 0.04535110955166067221 ; 0.04621766751092557684 ; 0.04697395904661414870 ; 0.04761604458525019296 ; 0.04814443257251220341 ;

 0.04855584485714105274 ; 0.04885125664306609371 ; 0.04902801843102555294 ; 0.04908762351494245585 ; 0.04902801843102555294 ;

 0.04885125664306609371 ; 0.04855584485714105274 ; 0.04814443257251220341 ; 0.04761604458525019296 ; 0.04697395904661414870 ;

 0.04621766751092557684 ; 0.04535110955166067221 ; 0.04437417923925731580 ; 0.04329151496169082935 ; 0.04210333111141810203 ;

 0.04081501340035783384 ; 0.03942698871295609976 ; 0.03794545992128481711 ; 0.03637092028663918309 ; 0.03471049818092511427 ;

 0.03296454656997632997 ; 0.03114129710406762447 ; 0.02924065319746833770 ; 0.02727225714146838686 ; 0.02523506498175476590 ;

 0.02314069493435819848 ; 0.02098627442973743378 ; 0.01878652974179578354 ; 0.01653498765728958965 ; 0.01425206043235199679 ;

 0.01192339471421277160 ; 0.00958233879528379039 ; 0.00719269316173611402 ; 0.00483146544879091264 ; 0.00235149067531170332 ;

 0.00024420024420024420 |] ;;





let clenshaw_curtis_129_x = [| -1. ; -0.99969881869620422012 ; -0.99879545620517239271 ; -0.99729045667869021614 ; -0.99518472667219688624 ;

 -0.99247953459870999816 ; -0.98917650996478097345 ; -0.98527764238894124477 ; -0.98078528040323044913 ; -0.97570213003852854446 ;

 -0.97003125319454399260 ; -0.96377606579543986669 ; -0.95694033573220886494 ; -0.94952818059303666720 ; -0.94154406518302077841 ;

 -0.93299279883473888771 ; -0.92387953251128675613 ; -0.91420975570353065464 ; -0.90398929312344333159 ; -0.89322430119551532034 ;

 -0.88192126434835502971 ; -0.87008699110871141865 ; -0.85772861000027206990 ; -0.84485356524970707326 ; -0.83146961230254523708 ;

 -0.81758481315158369650 ; -0.80320753148064490981 ; -0.78834642762660626201 ; -0.77301045336273696081 ; -0.75720884650648454758 ;

 -0.74095112535495909118 ; -0.72424708295146692094 ; -0.70710678118654752440 ; -0.68954054473706692462 ; -0.67155895484701840063 ;

 -0.65317284295377676408 ; -0.63439328416364549822 ; -0.61523159058062684548 ; -0.59569930449243334347 ; -0.57580819141784530075 ;

 -0.55557023301960222474 ; -0.53499761988709721066 ; -0.51410274419322172659 ; -0.49289819222978403687 ; -0.47139673682599764856 ;

 -0.44961132965460660005 ; -0.42755509343028209432 ; -0.40524131400498987091 ; -0.38268343236508977173 ; -0.35989503653498814878 ;

 -0.33688985339222005069 ; -0.31368174039889147666 ; -0.29028467725446236764 ; -0.26671275747489838633 ; -0.24298017990326388995 ;

 -0.21910124015686979723 ; -0.19509032201612826785 ; -0.17096188876030122636 ; -0.14673047445536175166 ; -0.12241067519921619850 ;

 -0.098017140329560601994 ; -0.073564563599667423529 ; -0.049067674327418014255 ; -0.024541228522912288032 ; 0. ; 0.024541228522912288032 ;

 0.049067674327418014255 ; 0.073564563599667423529 ; 0.098017140329560601994 ; 0.12241067519921619850 ; 0.14673047445536175166 ;

 0.17096188876030122636 ; 0.19509032201612826785 ; 0.21910124015686979723 ; 0.24298017990326388995 ; 0.26671275747489838633 ;

 0.29028467725446236764 ; 0.31368174039889147666 ; 0.33688985339222005069 ; 0.35989503653498814878 ; 0.38268343236508977173 ;

 0.40524131400498987091 ; 0.42755509343028209432 ; 0.44961132965460660005 ; 0.47139673682599764856 ; 0.49289819222978403687 ;

 0.51410274419322172659 ; 0.53499761988709721066 ; 0.55557023301960222474 ; 0.57580819141784530075 ; 0.59569930449243334347 ;

 0.61523159058062684548 ; 0.63439328416364549822 ; 0.65317284295377676408 ; 0.67155895484701840063 ; 0.68954054473706692462 ;

 0.70710678118654752440 ; 0.72424708295146692094 ; 0.74095112535495909118 ; 0.75720884650648454758 ; 0.77301045336273696081 ;

 0.78834642762660626201 ; 0.80320753148064490981 ; 0.81758481315158369650 ; 0.83146961230254523708 ; 0.84485356524970707326 ;

 0.85772861000027206990 ; 0.87008699110871141865 ; 0.88192126434835502971 ; 0.89322430119551532034 ; 0.90398929312344333159 ;

 0.91420975570353065464 ; 0.92387953251128675613 ; 0.93299279883473888771 ; 0.94154406518302077841 ; 0.94952818059303666720 ;

 0.95694033573220886494 ; 0.96377606579543986669 ; 0.97003125319454399260 ; 0.97570213003852854446 ; 0.98078528040323044913 ;

 0.98527764238894124477 ; 0.98917650996478097345 ; 0.99247953459870999816 ; 0.99518472667219688624 ; 0.99729045667869021614 ;

 0.99879545620517239271 ; 0.99969881869620422012 ; 1. |] ;;



let clenshaw_curtis_129_w = [| 0.00006103888176768602 ; 0.00058807215382869754 ; 0.00120930061875273991 ; 0.00180308126695362360 ;

 0.00240715327877140915 ; 0.00300345869904497128 ; 0.00360197835812614147 ; 0.00419553798718534675 ; 0.00478862143341336763 ;

 0.00537724746840184621 ; 0.00596388034730799521 ; 0.00654590843862298928 ; 0.00712483332325489785 ; 0.00769875778896082811 ;

 0.00826865154203087108 ; 0.00883303867470133581 ; 0.00939256583934814871 ; 0.00994602784923457905 ; 0.01049386202576892125 ;

 0.01103504877427254184 ; 0.01156988348290849967 ; 0.01209748052807164113 ; 0.01261803597977743271 ; 0.01313076516693974630 ;

 0.01363579321293772047 ; 0.01413241437853094133 ; 0.01462070254634350205 ; 0.01510001572479266783 ; 0.01557039073899425960 ;

 0.01603123858745057916 ; 0.01648256956220377909 ; 0.01692383985846499368 ; 0.01735504125411394958 ; 0.01777566938875279997 ;

 0.01818570377926339481 ; 0.01858467519566908661 ; 0.01897255587067948426 ; 0.01934890842392451844 ; 0.01971370183700155725 ;

 0.02006652805198357604 ; 0.02040735612003867863 ; 0.02073580533490147816 ; 0.02105184759002011131 ; 0.02135512797425970725 ;

 0.02164562356712882440 ; 0.02192300400598756892 ; 0.02218725355897195088 ; 0.02243806539722630184 ; 0.02267543270456671718 ;

 0.02289907134390605882 ; 0.02310898491627407168 ; 0.02330491126131143273 ; 0.02348686571193163505 ; 0.02365460746057766523 ;

 0.02380816473024258975 ; 0.02394731750476901502 ; 0.02407210792327850000 ; 0.02418233623893147567 ; 0.02427805942075745923 ;

 0.02435909748927643184 ; 0.02442552306156708690 ; 0.02447717542743444284 ; 0.02451414358881568292 ; 0.02453628559651495473 ;

 0.02454370750551418263 ; 0.02453628559651495473 ; 0.02451414358881568292 ; 0.02447717542743444284 ; 0.02442552306156708690 ;

 0.02435909748927643184 ; 0.02427805942075745923 ; 0.02418233623893147567 ; 0.02407210792327850000 ; 0.02394731750476901502 ;

 0.02380816473024258975 ; 0.02365460746057766523 ; 0.02348686571193163505 ; 0.02330491126131143273 ; 0.02310898491627407168 ;

 0.02289907134390605882 ; 0.02267543270456671718 ; 0.02243806539722630184 ; 0.02218725355897195088 ; 0.02192300400598756892 ;

 0.02164562356712882440 ; 0.02135512797425970725 ; 0.02105184759002011131 ; 0.02073580533490147816 ; 0.02040735612003867863 ;

 0.02006652805198357604 ; 0.01971370183700155725 ; 0.01934890842392451844 ; 0.01897255587067948426 ; 0.01858467519566908661 ;

 0.01818570377926339481 ; 0.01777566938875279997 ; 0.01735504125411394958 ; 0.01692383985846499368 ; 0.01648256956220377909 ;

 0.01603123858745057916 ; 0.01557039073899425960 ; 0.01510001572479266783 ; 0.01462070254634350205 ; 0.01413241437853094133 ;

 0.01363579321293772047 ; 0.01313076516693974630 ; 0.01261803597977743271 ; 0.01209748052807164113 ; 0.01156988348290849967 ;

 0.01103504877427254184 ; 0.01049386202576892125 ; 0.00994602784923457905 ; 0.00939256583934814871 ; 0.00883303867470133581 ;

 0.00826865154203087108 ; 0.00769875778896082811 ; 0.00712483332325489785 ; 0.00654590843862298928 ; 0.00596388034730799521 ;

 0.00537724746840184621 ; 0.00478862143341336763 ; 0.00419553798718534675 ; 0.00360197835812614147 ; 0.00300345869904497128 ;

 0.00240715327877140915 ; 0.00180308126695362360 ; 0.00120930061875273991 ; 0.00058807215382869754 ; 0.00006103888176768602 |] ;;





let gauss_legendre_1_x = [| 0.0 |] ;;



let gauss_legendre_1_w = [| 2.0 |] ;;





let gauss_legendre_2_x = [| -0.577350269189625764509148780502 ; 0.577350269189625764509148780502 |] ;;



let gauss_legendre_2_w = [| 1.0 ; 1.0 |] ;;





let gauss_legendre_3_x = [| -0.774596669241483377035853079956 ; 0.0 ; 0.774596669241483377035853079956 |] ;;



let gauss_legendre_3_w = [| 0.555555555555555555555555555556 ; 0.888888888888888888888888888889 ; 0.555555555555555555555555555556 |] ;;





let gauss_legendre_4_x = [| -0.861136311594052575223946488893 ; -0.339981043584856264802665759103 ; 0.339981043584856264802665759103 ; 0.861136311594052575223946488893 |] ;;



let gauss_legendre_4_w = [| 0.347854845137453857373063949222 ; 0.652145154862546142626936050778 ; 0.652145154862546142626936050778 ; 0.347854845137453857373063949222 |] ;;





let gauss_legendre_5_x = [| -0.906179845938663992797626878299 ; -0.538469310105683091036314420700 ;

 0.0 ; 0.538469310105683091036314420700 ; 0.906179845938663992797626878299 |] ;;



let gauss_legendre_5_w = [| 0.236926885056189087514264040720 ; 0.478628670499366468041291514836 ; 0.568888888888888888888888888889 ;

 0.478628670499366468041291514836 ; 0.236926885056189087514264040720 |] ;;





let gauss_legendre_6_x = [| -0.932469514203152027812301554494 ; -0.661209386466264513661399595020 ; -0.238619186083196908630501721681 ;

 0.238619186083196908630501721681 ; 0.661209386466264513661399595020 ; 0.932469514203152027812301554494 |] ;;



let gauss_legendre_6_w = [| 0.171324492379170345040296142173 ; 0.360761573048138607569833513838 ; 0.467913934572691047389870343990 ;

 0.467913934572691047389870343990 ; 0.360761573048138607569833513838 ; 0.171324492379170345040296142173 |] ;;





let gauss_legendre_7_x = [| -0.949107912342758524526189684048 ; -0.741531185599394439863864773281 ; -0.405845151377397166906606412077 ;

 0.0 ; 0.405845151377397166906606412077 ; 0.741531185599394439863864773281 ; 0.949107912342758524526189684048 |] ;;



let gauss_legendre_7_w = [| 0.129484966168869693270611432679 ; 0.279705391489276667901467771424 ; 0.381830050505118944950369775489 ; 0.417959183673469387755102040816 ;

 0.381830050505118944950369775489 ; 0.279705391489276667901467771424 ; 0.129484966168869693270611432679 |] ;;





let gauss_legendre_8_x = [| -0.960289856497536231683560868569 ; -0.796666477413626739591553936476 ; -0.525532409916328985817739049189 ; -0.183434642495649804939476142360 ;

 0.183434642495649804939476142360 ; 0.525532409916328985817739049189 ; 0.796666477413626739591553936476 ; 0.960289856497536231683560868569 |] ;;



let gauss_legendre_8_w = [| 0.101228536290376259152531354310 ; 0.222381034453374470544355994426 ; 0.313706645877887287337962201987 ; 0.362683783378361982965150449277 ;

 0.362683783378361982965150449277 ; 0.313706645877887287337962201987 ; 0.222381034453374470544355994426 ; 0.101228536290376259152531354310 |] ;;





let gauss_legendre_9_x = [| -0.968160239507626089835576203 ; -0.836031107326635794299429788 ; -0.613371432700590397308702039 ; -0.324253423403808929038538015 ;

 0.0 ; 0.324253423403808929038538015 ; 0.613371432700590397308702039 ; 0.836031107326635794299429788 ; 0.968160239507626089835576203 |] ;;



let gauss_legendre_9_w = [| 0.081274388361574411971892158111 ; 0.18064816069485740405847203124 ; 0.26061069640293546231874286942 ; 0.31234707704000284006863040658 ;

 0.33023935500125976316452506929 ; 0.31234707704000284006863040658 ; 0.26061069640293546231874286942 ; 0.18064816069485740405847203124 ; 0.081274388361574411971892158111 |] ;;





let gauss_legendre_10_x = [| -0.973906528517171720077964012 ; -0.865063366688984510732096688 ; -0.679409568299024406234327365 ; -0.433395394129247190799265943 ;

 -0.148874338981631210884826001 ; 0.148874338981631210884826001 ; 0.433395394129247190799265943 ; 0.679409568299024406234327365 ; 0.865063366688984510732096688 ;

 0.973906528517171720077964012 |] ;;



let gauss_legendre_10_w = [| 0.066671344308688137593568809893 ; 0.14945134915058059314577633966 ; 0.21908636251598204399553493423 ; 0.26926671930999635509122692157 ;

 0.29552422471475287017389299465 ; 0.29552422471475287017389299465 ; 0.26926671930999635509122692157 ; 0.21908636251598204399553493423 ; 0.14945134915058059314577633966 ;

 0.066671344308688137593568809893 |] ;;





let gauss_legendre_11_x = [| -0.978228658146056992803938001 ; -0.887062599768095299075157769 ; -0.730152005574049324093416252 ; -0.519096129206811815925725669 ;

 -0.269543155952344972331531985 ; 0.0 ; 0.269543155952344972331531985 ; 0.519096129206811815925725669 ; 0.730152005574049324093416252 ;

 0.887062599768095299075157769 ; 0.978228658146056992803938001 |] ;;



let gauss_legendre_11_w = [| 0.055668567116173666482753720443 ; 0.12558036946490462463469429922 ; 0.18629021092773425142609764143 ; 0.23319376459199047991852370484 ;

 0.26280454451024666218068886989 ; 0.27292508677790063071448352834 ; 0.26280454451024666218068886989 ; 0.23319376459199047991852370484 ; 0.18629021092773425142609764143 ;

 0.12558036946490462463469429922 ; 0.055668567116173666482753720443 |] ;;





let gauss_legendre_12_x = [| -0.981560634246719250690549090 ; -0.904117256370474856678465866 ; -0.769902674194304687036893833 ; -0.587317954286617447296702419 ;

 -0.367831498998180193752691537 ; -0.125233408511468915472441369 ; 0.125233408511468915472441369 ; 0.367831498998180193752691537 ; 0.587317954286617447296702419 ;

 0.769902674194304687036893833 ; 0.904117256370474856678465866 ; 0.981560634246719250690549090 |] ;;



let gauss_legendre_12_w = [| 0.047175336386511827194615961485 ; 0.10693932599531843096025471819 ; 0.16007832854334622633465252954 ; 0.20316742672306592174906445581 ;

 0.23349253653835480876084989892 ; 0.24914704581340278500056243604 ; 0.24914704581340278500056243604 ; 0.23349253653835480876084989892 ; 0.20316742672306592174906445581 ;

 0.16007832854334622633465252954 ; 0.10693932599531843096025471819 ; 0.047175336386511827194615961485 |] ;;





let gauss_legendre_13_x = [| -0.984183054718588149472829449 ; -0.917598399222977965206547837 ; -0.801578090733309912794206490 ; -0.642349339440340220643984607 ;

 -0.448492751036446852877912852 ; -0.230458315955134794065528121 ; 0.0 ; 0.230458315955134794065528121 ; 0.448492751036446852877912852 ; 0.642349339440340220643984607 ;

 0.80157809073330991279420649 ; 0.91759839922297796520654784 ; 0.98418305471858814947282945 |] ;;



let gauss_legendre_13_w = [| 0.040484004765315879520021592201 ; 0.092121499837728447914421775954 ; 0.13887351021978723846360177687 ; 0.17814598076194573828004669200 ;

 0.20781604753688850231252321931 ; 0.22628318026289723841209018604 ; 0.23255155323087391019458951527 ; 0.22628318026289723841209018604 ; 0.20781604753688850231252321931 ;

 0.17814598076194573828004669200 ; 0.13887351021978723846360177687 ; 0.092121499837728447914421775954 ; 0.040484004765315879520021592201 |] ;;





let gauss_legendre_14_x = [| -0.986283808696812338841597267 ; -0.928434883663573517336391139 ; -0.827201315069764993189794743 ; -0.687292904811685470148019803 ;

 -0.515248636358154091965290719 ; -0.319112368927889760435671824 ; -0.108054948707343662066244650 ; 0.108054948707343662066244650 ; 0.31911236892788976043567182 ;

 0.51524863635815409196529072 ; 0.68729290481168547014801980 ; 0.82720131506976499318979474 ; 0.92843488366357351733639114 ; 0.98628380869681233884159727 |] ;;



let gauss_legendre_14_w = [| 0.035119460331751863031832876138 ; 0.08015808715976020980563327706 ; 0.12151857068790318468941480907 ; 0.15720316715819353456960193862 ;

 0.18553839747793781374171659013 ; 0.20519846372129560396592406566 ; 0.21526385346315779019587644332 ; 0.21526385346315779019587644332 ; 0.20519846372129560396592406566 ;

 0.18553839747793781374171659013 ; 0.15720316715819353456960193862 ; 0.12151857068790318468941480907 ; 0.08015808715976020980563327706 ; 0.035119460331751863031832876138 |] ;;





let gauss_legendre_15_x = [| -0.987992518020485428489565719 ; -0.937273392400705904307758948 ; -0.848206583410427216200648321 ; -0.724417731360170047416186055 ;

 -0.570972172608538847537226737 ; -0.394151347077563369897207371 ; -0.201194093997434522300628303 ; 0.0 ; 0.20119409399743452230062830 ; 0.39415134707756336989720737 ;

 0.57097217260853884753722674 ; 0.72441773136017004741618605 ; 0.84820658341042721620064832 ; 0.93727339240070590430775895 ; 0.98799251802048542848956572 |] ;;



let gauss_legendre_15_w = [| 0.030753241996117268354628393577 ; 0.070366047488108124709267416451 ; 0.107159220467171935011869546686 ; 0.13957067792615431444780479451 ;

 0.16626920581699393355320086048 ; 0.18616100001556221102680056187 ; 0.19843148532711157645611832644 ; 0.20257824192556127288062019997 ; 0.19843148532711157645611832644 ;

 0.18616100001556221102680056187 ; 0.16626920581699393355320086048 ; 0.13957067792615431444780479451 ; 0.107159220467171935011869546686 ; 0.070366047488108124709267416451 ;

 0.030753241996117268354628393577 |] ;;





let gauss_legendre_16_x = [| -0.989400934991649932596154173 ; -0.944575023073232576077988416 ; -0.865631202387831743880467898 ; -0.755404408355003033895101195 ;

 -0.617876244402643748446671764 ; -0.458016777657227386342419443 ; -0.281603550779258913230460501 ; -0.09501250983763744018531934 ; 0.09501250983763744018531934 ;

 0.28160355077925891323046050 ; 0.45801677765722738634241944 ; 0.61787624440264374844667176 ; 0.75540440835500303389510119 ; 0.86563120238783174388046790 ;

 0.94457502307323257607798842 ; 0.98940093499164993259615417 |] ;;



let gauss_legendre_16_w = [| 0.027152459411754094851780572456 ; 0.062253523938647892862843836994 ; 0.09515851168249278480992510760 ; 0.12462897125553387205247628219 ;

 0.14959598881657673208150173055 ; 0.16915651939500253818931207903 ; 0.18260341504492358886676366797 ; 0.18945061045506849628539672321 ; 0.18945061045506849628539672321 ;

 0.18260341504492358886676366797 ; 0.16915651939500253818931207903 ; 0.14959598881657673208150173055 ; 0.12462897125553387205247628219 ; 0.09515851168249278480992510760 ;

 0.062253523938647892862843836994 ; 0.027152459411754094851780572456 |] ;;





let gauss_legendre_17_x = [| -0.990575475314417335675434020 ; -0.950675521768767761222716958 ; -0.880239153726985902122955694 ; -0.781514003896801406925230056 ;

 -0.657671159216690765850302217 ; -0.512690537086476967886246569 ; -0.35123176345387631529718552 ; -0.17848418149584785585067749 ; 0.0 ; 0.17848418149584785585067749 ;

 0.35123176345387631529718552 ; 0.51269053708647696788624657 ; 0.65767115921669076585030222 ; 0.78151400389680140692523006 ; 0.88023915372698590212295569 ;

 0.95067552176876776122271696 ; 0.99057547531441733567543402 |] ;;



let gauss_legendre_17_w = [| 0.024148302868547931960110026288 ; 0.055459529373987201129440165359 ; 0.085036148317179180883535370191 ; 0.111883847193403971094788385626 ;

 0.13513636846852547328631998170 ; 0.15404576107681028808143159480 ; 0.16800410215645004450997066379 ; 0.17656270536699264632527099011 ; 0.17944647035620652545826564426 ;

 0.17656270536699264632527099011 ; 0.16800410215645004450997066379 ; 0.15404576107681028808143159480 ; 0.13513636846852547328631998170 ; 0.111883847193403971094788385626 ;

 0.085036148317179180883535370191 ; 0.055459529373987201129440165359 ; 0.024148302868547931960110026288 |] ;;





let gauss_legendre_18_x = [| -0.991565168420930946730016005 ; -0.955823949571397755181195893 ; -0.892602466497555739206060591 ; -0.803704958972523115682417455 ;

 -0.691687043060353207874891081 ; -0.55977083107394753460787155 ; -0.41175116146284264603593179 ; -0.25188622569150550958897285 ; -0.08477501304173530124226185 ;

 0.08477501304173530124226185 ; 0.25188622569150550958897285 ; 0.41175116146284264603593179 ; 0.55977083107394753460787155 ; 0.69168704306035320787489108 ;

 0.80370495897252311568241746 ; 0.89260246649755573920606059 ; 0.95582394957139775518119589 ; 0.99156516842093094673001600 |] ;;



let gauss_legendre_18_w = [| 0.021616013526483310313342710266 ; 0.049714548894969796453334946203 ; 0.07642573025488905652912967762 ; 0.10094204410628716556281398492 ;

 0.12255520671147846018451912680 ; 0.14064291467065065120473130375 ; 0.15468467512626524492541800384 ; 0.16427648374583272298605377647 ; 0.16914238296314359184065647013 ;

 0.16914238296314359184065647013 ; 0.16427648374583272298605377647 ; 0.15468467512626524492541800384 ; 0.14064291467065065120473130375 ; 0.12255520671147846018451912680 ;

 0.10094204410628716556281398492 ; 0.07642573025488905652912967762 ; 0.049714548894969796453334946203 ; 0.021616013526483310313342710266 |] ;;





let gauss_legendre_19_x = [| -0.992406843843584403189017670 ; -0.960208152134830030852778841 ; -0.903155903614817901642660929 ; -0.822714656537142824978922487 ;

 -0.72096617733522937861709586 ; -0.60054530466168102346963816 ; -0.46457074137596094571726715 ; -0.31656409996362983199011733 ; -0.16035864564022537586809612 ;

 0.0 ; 0.16035864564022537586809612 ; 0.31656409996362983199011733 ; 0.46457074137596094571726715 ; 0.60054530466168102346963816 ; 0.72096617733522937861709586 ;

 0.82271465653714282497892249 ; 0.90315590361481790164266093 ; 0.96020815213483003085277884 ; 0.99240684384358440318901767 |] ;;



let gauss_legendre_19_w = [| 0.019461788229726477036312041464 ; 0.044814226765699600332838157402 ; 0.069044542737641226580708258006 ; 0.091490021622449999464462094124 ;

 0.111566645547333994716023901682 ; 0.12875396253933622767551578486 ; 0.14260670217360661177574610944 ; 0.15276604206585966677885540090 ; 0.15896884339395434764995643946 ;

 0.16105444984878369597916362532 ; 0.15896884339395434764995643946 ; 0.15276604206585966677885540090 ; 0.14260670217360661177574610944 ; 0.12875396253933622767551578486 ;

 0.111566645547333994716023901682 ; 0.091490021622449999464462094124 ; 0.069044542737641226580708258006 ; 0.044814226765699600332838157402 ; 0.019461788229726477036312041464 |] ;;





let gauss_legendre_20_x = [| -0.993128599185094924786122388 ; -0.963971927277913791267666131 ; -0.912234428251325905867752441 ; -0.83911697182221882339452906 ;

 -0.74633190646015079261430507 ; -0.63605368072651502545283670 ; -0.51086700195082709800436405 ; -0.37370608871541956067254818 ; -0.22778585114164507808049620 ;

 -0.07652652113349733375464041 ; 0.07652652113349733375464041 ; 0.22778585114164507808049620 ; 0.37370608871541956067254818 ; 0.51086700195082709800436405 ;

 0.63605368072651502545283670 ; 0.74633190646015079261430507 ; 0.83911697182221882339452906 ; 0.91223442825132590586775244 ; 0.96397192727791379126766613 ;

 0.99312859918509492478612239 |] ;;



let gauss_legendre_20_w = [| 0.017614007139152118311861962352 ; 0.040601429800386941331039952275 ; 0.062672048334109063569506535187 ; 0.08327674157670474872475814322 ;

 0.10193011981724043503675013548 ; 0.11819453196151841731237737771 ; 0.13168863844917662689849449975 ; 0.14209610931838205132929832507 ; 0.14917298647260374678782873700 ;

 0.15275338713072585069808433195 ; 0.15275338713072585069808433195 ; 0.14917298647260374678782873700 ; 0.14209610931838205132929832507 ; 0.13168863844917662689849449975 ;

 0.11819453196151841731237737771 ; 0.10193011981724043503675013548 ; 0.08327674157670474872475814322 ; 0.062672048334109063569506535187 ; 0.040601429800386941331039952275 ;

 0.017614007139152118311861962352 |] ;;





let gauss_legendre_21_x = [| -0.99375217062038950026024204 ; -0.96722683856630629431662221 ; -0.92009933415040082879018713 ; -0.85336336458331728364725064 ;

 -0.76843996347567790861587785 ; -0.66713880419741231930596667 ; -0.55161883588721980705901880 ; -0.42434212020743878357366889 ; -0.28802131680240109660079252 ;

 -0.14556185416089509093703098 ; 0.0 ; 0.14556185416089509093703098 ; 0.28802131680240109660079252 ; 0.42434212020743878357366889 ; 0.55161883588721980705901880 ;

 0.66713880419741231930596667 ; 0.76843996347567790861587785 ; 0.85336336458331728364725064 ; 0.92009933415040082879018713 ; 0.96722683856630629431662221 ;

 0.99375217062038950026024204 |] ;;



let gauss_legendre_21_w = [| 0.016017228257774333324224616858 ; 0.036953789770852493799950668299 ; 0.057134425426857208283635826472 ; 0.076100113628379302017051653300 ;

 0.093444423456033861553289741114 ; 0.108797299167148377663474578070 ; 0.12183141605372853419536717713 ; 0.13226893863333746178105257450 ; 0.13988739479107315472213342387 ;

 0.14452440398997005906382716655 ; 0.14608113364969042719198514768 ; 0.14452440398997005906382716655 ; 0.13988739479107315472213342387 ;  0.13226893863333746178105257450 ;

 0.12183141605372853419536717713 ; 0.108797299167148377663474578070 ; 0.093444423456033861553289741114 ; 0.076100113628379302017051653300 ; 0.057134425426857208283635826472 ;

 0.036953789770852493799950668299 ; 0.016017228257774333324224616858 |] ;;





let gauss_legendre_22_x = [| -0.99429458548239929207303142 ; -0.97006049783542872712395099 ; -0.92695677218717400052069294 ; -0.86581257772030013653642564 ;

 -0.78781680597920816200427796 ; -0.69448726318668278005068984 ; -0.58764040350691159295887693 ; -0.46935583798675702640633071 ; -0.34193582089208422515814742 ;

 -0.20786042668822128547884653 ; -0.06973927331972222121384180 ; 0.06973927331972222121384180 ; 0.20786042668822128547884653 ; 0.34193582089208422515814742 ;

 0.46935583798675702640633071 ; 0.58764040350691159295887693 ; 0.69448726318668278005068984 ; 0.78781680597920816200427796 ; 0.86581257772030013653642564 ;

 0.92695677218717400052069294 ; 0.97006049783542872712395099 ; 0.99429458548239929207303142 |] ;;

 

let gauss_legendre_22_w = [| 0.014627995298272200684991098047 ; 0.033774901584814154793302246866 ; 0.052293335152683285940312051273 ; 0.06979646842452048809496141893 ;

 0.08594160621706772741444368137 ; 0.10041414444288096493207883783 ; 0.11293229608053921839340060742 ; 0.12325237681051242428556098615 ; 0.13117350478706237073296499253 ;

 0.13654149834601517135257383123 ; 0.13925187285563199337541024834 ; 0.13925187285563199337541024834 ; 0.13654149834601517135257383123 ; 0.13117350478706237073296499253 ;

 0.12325237681051242428556098615 ; 0.11293229608053921839340060742 ; 0.10041414444288096493207883783 ; 0.08594160621706772741444368137 ; 0.06979646842452048809496141893 ;

 0.052293335152683285940312051273 ; 0.033774901584814154793302246866 ; 0.014627995298272200684991098047 |] ;;





let gauss_legendre_23_x = [| -0.99476933499755212352392572 ; -0.97254247121811523195602408 ; -0.93297108682601610234919699 ; -0.87675235827044166737815689 ;

 -0.80488840161883989215111841 ; -0.71866136313195019446162448 ; -0.61960987576364615638509731 ; -0.50950147784600754968979305 ; -0.39030103803029083142148887 ;

 -0.26413568097034493053386954 ; -0.13325682429846611093174268 ; 0.0 ; 0.13325682429846611093174268 ; 0.26413568097034493053386954 ; 0.39030103803029083142148887 ;

 0.50950147784600754968979305 ; 0.61960987576364615638509731 ; 0.71866136313195019446162448 ; 0.80488840161883989215111841 ; 0.87675235827044166737815689 ;

 0.93297108682601610234919699 ; 0.97254247121811523195602408 ; 0.99476933499755212352392572 |] ;;



let gauss_legendre_23_w = [| 0.013411859487141772081309493459 ; 0.030988005856979444310694219642 ; 0.048037671731084668571641071632 ; 0.064232421408525852127169615159 ;

 0.079281411776718954922892524742 ; 0.092915766060035147477018617370 ; 0.104892091464541410074086185015 ; 0.11499664022241136494164351293 ; 0.12304908430672953046757840067 ;

 0.12890572218808214997859533940 ; 0.13246203940469661737164246470 ; 0.13365457218610617535145711055 ; 0.13246203940469661737164246470 ; 0.12890572218808214997859533940 ;

 0.12304908430672953046757840067 ; 0.11499664022241136494164351293 ; 0.104892091464541410074086185015 ; 0.092915766060035147477018617370 ; 0.079281411776718954922892524742 ;

 0.064232421408525852127169615159 ; 0.048037671731084668571641071632 ; 0.030988005856979444310694219642 ; 0.013411859487141772081309493459 |] ;;





let gauss_legendre_24_x = [| -0.99518721999702136017999741 ; -0.97472855597130949819839199 ; -0.93827455200273275852364900 ; -0.88641552700440103421315434 ;

 -0.82000198597390292195394987 ; -0.74012419157855436424382810 ; -0.64809365193697556925249579 ; -0.54542147138883953565837562 ; -0.43379350762604513848708423 ;

 -0.31504267969616337438679329 ; -0.19111886747361630915863982 ; -0.06405689286260562608504308 ; 0.06405689286260562608504308 ; 0.19111886747361630915863982 ;

 0.31504267969616337438679329 ; 0.43379350762604513848708423 ; 0.54542147138883953565837562 ; 0.64809365193697556925249579 ; 0.74012419157855436424382810 ;

 0.82000198597390292195394987 ; 0.88641552700440103421315434 ; 0.93827455200273275852364900 ; 0.97472855597130949819839199 ; 0.99518721999702136017999741 |] ;;



let gauss_legendre_24_w = [| 0.012341229799987199546805667070 ; 0.028531388628933663181307815952 ; 0.044277438817419806168602748211 ; 0.059298584915436780746367758500 ;

 0.07334648141108030573403361525 ; 0.08619016153195327591718520298 ; 0.09761865210411388826988066446 ; 0.10744427011596563478257734245 ; 0.11550566805372560135334448391 ;

 0.12167047292780339120446315348 ; 0.12583745634682829612137538251 ; 0.12793819534675215697405616522 ; 0.12793819534675215697405616522 ; 0.12583745634682829612137538251 ;

 0.12167047292780339120446315348 ; 0.11550566805372560135334448391 ; 0.10744427011596563478257734245 ; 0.09761865210411388826988066446 ; 0.08619016153195327591718520298 ;

 0.07334648141108030573403361525 ; 0.059298584915436780746367758500 ; 0.044277438817419806168602748211 ; 0.028531388628933663181307815952 ; 0.012341229799987199546805667070 |] ;;





let gauss_legendre_25_x = [| -0.99555696979049809790878495 ; -0.97666392145951751149831539 ; -0.94297457122897433941401117 ; -0.89499199787827536885104201 ;

 -0.83344262876083400142102111 ; -0.75925926303735763057728287 ; -0.67356636847346836448512063 ; -0.57766293024122296772368984 ; -0.47300273144571496052218212 ;

 -0.36117230580938783773582173 ; -0.24386688372098843204519036 ; -0.12286469261071039638735982 ; 0.0 ; 0.12286469261071039638735982 ; 0.24386688372098843204519036 ;

 0.36117230580938783773582173 ; 0.47300273144571496052218212 ; 0.57766293024122296772368984 ; 0.67356636847346836448512063 ; 0.75925926303735763057728287 ;

 0.83344262876083400142102111 ; 0.89499199787827536885104201 ; 0.94297457122897433941401117 ; 0.97666392145951751149831539 ; 0.99555696979049809790878495 |] ;;



let gauss_legendre_25_w = [| 0.0113937985010262879479029641132 ; 0.026354986615032137261901815295 ; 0.040939156701306312655623487712 ; 0.054904695975835191925936891541 ;

 0.068038333812356917207187185657 ; 0.080140700335001018013234959669 ; 0.091028261982963649811497220703 ; 0.100535949067050644202206890393 ; 0.108519624474263653116093957050 ;

 0.11485825914571164833932554587 ; 0.11945576353578477222817812651 ; 0.12224244299031004168895951895 ; 0.12317605372671545120390287308 ; 0.12224244299031004168895951895 ;

 0.11945576353578477222817812651 ; 0.11485825914571164833932554587 ; 0.108519624474263653116093957050 ; 0.100535949067050644202206890393 ; 0.091028261982963649811497220703 ;

 0.080140700335001018013234959669 ; 0.068038333812356917207187185657 ; 0.054904695975835191925936891541 ; 0.040939156701306312655623487712 ; 0.026354986615032137261901815295 ;

 0.0113937985010262879479029641132 |] ;;





let gauss_legendre_26_x = [| -0.99588570114561692900321696 ; -0.97838544595647099110058035 ; -0.94715906666171425013591528 ; -0.90263786198430707421766560 ;

 -0.84544594278849801879750706 ; -0.77638594882067885619296725 ; -0.69642726041995726486381391 ; -0.60669229301761806323197875 ; -0.50844071482450571769570306 ;

 -0.40305175512348630648107738 ; -0.29200483948595689514283538 ; -0.17685882035689018396905775 ; -0.05923009342931320709371858 ; 0.05923009342931320709371858 ;

 0.17685882035689018396905775 ; 0.29200483948595689514283538 ; 0.40305175512348630648107738 ; 0.50844071482450571769570306 ; 0.60669229301761806323197875 ;

 0.69642726041995726486381391 ; 0.77638594882067885619296725 ; 0.84544594278849801879750706 ; 0.90263786198430707421766560 ; 0.94715906666171425013591528 ;

 0.97838544595647099110058035 ; 0.99588570114561692900321696 |] ;;



let gauss_legendre_26_w = [| 0.010551372617343007155651187685 ; 0.024417851092631908789615827520 ; 0.037962383294362763950303141249 ; 0.050975825297147811998319900724 ;

 0.063274046329574835539453689907 ; 0.07468414976565974588707579610 ; 0.08504589431348523921044776508 ; 0.09421380035591414846366488307 ; 0.10205916109442542323841407025 ;

 0.10847184052857659065657942673 ; 0.11336181654631966654944071844 ; 0.11666044348529658204466250754 ; 0.11832141527926227651637108570 ; 0.11832141527926227651637108570 ;

 0.11666044348529658204466250754 ; 0.11336181654631966654944071844 ; 0.10847184052857659065657942673 ; 0.10205916109442542323841407025 ; 0.09421380035591414846366488307 ;

 0.08504589431348523921044776508 ; 0.07468414976565974588707579610 ; 0.063274046329574835539453689907 ; 0.050975825297147811998319900724 ; 0.037962383294362763950303141249 ;

 0.024417851092631908789615827520 ; 0.010551372617343007155651187685 |] ;;





let gauss_legendre_27_x = [| -0.99617926288898856693888721 ; -0.97992347596150122285587336 ; -0.95090055781470500685190803 ; -0.90948232067749110430064502 ;

 -0.85620790801829449030273722 ; -0.79177163907050822714439734 ; -0.71701347373942369929481621 ; -0.63290797194649514092773464 ; -0.54055156457945689490030094 ;

 -0.44114825175002688058597416 ; -0.33599390363850889973031903 ; -0.22645936543953685885723911 ; -0.11397258560952996693289498 ; 0.0 ; 0.11397258560952996693289498 ;

 0.22645936543953685885723911 ; 0.33599390363850889973031903 ; 0.44114825175002688058597416 ; 0.54055156457945689490030094 ; 0.63290797194649514092773464 ;

 0.71701347373942369929481621 ; 0.79177163907050822714439734 ; 0.85620790801829449030273722 ; 0.90948232067749110430064502 ; 0.95090055781470500685190803 ;

 0.97992347596150122285587336 ; 0.99617926288898856693888721 |] ;;



let gauss_legendre_27_w = [| 0.0097989960512943602611500550912 ; 0.022686231596180623196034206447 ; 0.035297053757419711022578289305 ; 0.047449412520615062704096710114 ;

 0.058983536859833599110300833720 ; 0.069748823766245592984322888357 ; 0.079604867773057771263074959010 ; 0.088423158543756950194322802854 ; 0.096088727370028507565652646558 ;

 0.102501637817745798671247711533 ; 0.107578285788533187212162984427 ; 0.111252488356845192672163096043 ; 0.113476346108965148620369948092 ; 0.11422086737895698904504573690 ;

 0.113476346108965148620369948092 ; 0.111252488356845192672163096043 ; 0.107578285788533187212162984427 ; 0.102501637817745798671247711533 ; 0.096088727370028507565652646558 ;

 0.088423158543756950194322802854 ; 0.079604867773057771263074959010 ; 0.069748823766245592984322888357 ; 0.058983536859833599110300833720 ; 0.047449412520615062704096710114 ;

 0.035297053757419711022578289305 ; 0.022686231596180623196034206447 ; 0.0097989960512943602611500550912 |] ;;





let gauss_legendre_28_x = [| -0.99644249757395444995043639 ; -0.98130316537087275369455995 ; -0.95425928062893819725410184 ; -0.91563302639213207386968942 ;

 -0.86589252257439504894225457 ; -0.80564137091717917144788596 ; -0.73561087801363177202814451 ; -0.65665109403886496121989818 ; -0.56972047181140171930800328 ;

 -0.47587422495511826103441185 ; -0.37625151608907871022135721 ; -0.27206162763517807767682636 ; -0.16456928213338077128147178 ; -0.05507928988403427042651653 ;

 0.05507928988403427042651653 ; 0.16456928213338077128147178 ; 0.27206162763517807767682636 ; 0.37625151608907871022135721 ; 0.47587422495511826103441185 ;

 0.56972047181140171930800328 ; 0.65665109403886496121989818 ; 0.73561087801363177202814451 ; 0.80564137091717917144788596 ; 0.86589252257439504894225457 ;

 0.91563302639213207386968942 ; 0.95425928062893819725410184 ; 0.98130316537087275369455995 ; 0.99644249757395444995043639 |] ;;



let gauss_legendre_28_w = [| 0.009124282593094517738816153923 ; 0.021132112592771259751500380993 ; 0.032901427782304379977630819171 ; 0.044272934759004227839587877653 ;

 0.055107345675716745431482918227 ; 0.06527292396699959579339756678 ; 0.07464621423456877902393188717 ; 0.08311341722890121839039649824 ; 0.09057174439303284094218603134 ;

 0.09693065799792991585048900610 ; 0.10211296757806076981421663851 ; 0.10605576592284641791041643700 ; 0.10871119225829413525357151930 ; 0.11004701301647519628237626560 ;

 0.11004701301647519628237626560 ; 0.10871119225829413525357151930 ; 0.10605576592284641791041643700 ; 0.10211296757806076981421663851 ; 0.09693065799792991585048900610 ;

 0.09057174439303284094218603134 ; 0.08311341722890121839039649824 ; 0.07464621423456877902393188717 ; 0.06527292396699959579339756678 ; 0.055107345675716745431482918227 ;

 0.044272934759004227839587877653 ; 0.032901427782304379977630819171 ; 0.021132112592771259751500380993 ; 0.009124282593094517738816153923 |] ;;





let gauss_legendre_29_x = [| -0.99667944226059658616319153 ; -0.98254550526141317487092602 ; -0.95728559577808772579820804 ; -0.92118023295305878509375344 ;

 -0.87463780492010279041779342 ; -0.81818548761525244498957221 ; -0.75246285173447713391261008 ; -0.67821453760268651515618501 ; -0.59628179713822782037958621 ;

 -0.50759295512422764210262792 ; -0.41315288817400866389070659 ; -0.31403163786763993494819592 ; -0.21135228616600107450637573 ; -0.10627823013267923017098239 ;

 0.0 ; 0.10627823013267923017098239 ; 0.21135228616600107450637573 ; 0.31403163786763993494819592 ; 0.41315288817400866389070659 ; 0.50759295512422764210262792 ;

 0.59628179713822782037958621 ; 0.67821453760268651515618501 ; 0.75246285173447713391261008 ; 0.81818548761525244498957221 ; 0.87463780492010279041779342 ;

 0.92118023295305878509375344 ; 0.95728559577808772579820804 ; 0.98254550526141317487092602 ; 0.99667944226059658616319153 |] ;;



let gauss_legendre_29_w = [| 0.0085169038787464096542638133022 ; 0.019732085056122705983859801640 ; 0.030740492202093622644408525375 ; 0.041402062518682836104830010114 ;

 0.051594826902497923912594381180 ; 0.061203090657079138542109848024 ; 0.070117933255051278569581486949 ; 0.078238327135763783828144888660 ; 0.085472257366172527545344849297 ;

 0.091737757139258763347966411077 ; 0.096963834094408606301900074883 ; 0.101091273759914966121820546907 ; 0.104073310077729373913328471285 ; 0.105876155097320941406591327852 ;

 0.10647938171831424424651112691 ; 0.105876155097320941406591327852 ; 0.104073310077729373913328471285 ; 0.101091273759914966121820546907 ; 0.096963834094408606301900074883 ;

 0.091737757139258763347966411077 ; 0.085472257366172527545344849297 ; 0.078238327135763783828144888660 ; 0.070117933255051278569581486949 ; 0.061203090657079138542109848024 ;

 0.051594826902497923912594381180 ; 0.041402062518682836104830010114 ; 0.030740492202093622644408525375 ; 0.019732085056122705983859801640 ; 0.0085169038787464096542638133022 |] ;;





let gauss_legendre_30_x = [| -0.99689348407464954027163005 ; -0.98366812327974720997003258 ; -0.96002186496830751221687103 ; -0.92620004742927432587932428 ;

 -0.88256053579205268154311646 ; -0.82956576238276839744289812 ; -0.76777743210482619491797734 ; -0.69785049479331579693229239 ; -0.62052618298924286114047756 ;

 -0.53662414814201989926416979 ; -0.44703376953808917678060990 ; -0.35270472553087811347103721 ; -0.25463692616788984643980513 ; -0.15386991360858354696379467 ;

 -0.05147184255531769583302521 ; 0.05147184255531769583302521 ; 0.15386991360858354696379467 ; 0.25463692616788984643980513 ; 0.35270472553087811347103721 ;

 0.44703376953808917678060990 ; 0.53662414814201989926416979 ; 0.62052618298924286114047756 ; 0.69785049479331579693229239 ; 0.76777743210482619491797734 ;

 0.82956576238276839744289812 ; 0.88256053579205268154311646 ; 0.92620004742927432587932428 ; 0.96002186496830751221687103 ; 0.98366812327974720997003258 ;

 0.99689348407464954027163005 |] ;;



let gauss_legendre_30_w = [| 0.007968192496166605615465883475 ; 0.018466468311090959142302131912 ; 0.028784707883323369349719179611 ; 0.038799192569627049596801936446 ;

 0.048402672830594052902938140423 ; 0.057493156217619066481721689402 ; 0.06597422988218049512812851512 ; 0.07375597473770520626824385002 ; 0.08075589522942021535469493846 ;

 0.08689978720108297980238753072 ; 0.09212252223778612871763270709 ; 0.09636873717464425963946862635 ; 0.09959342058679526706278028210 ; 0.10176238974840550459642895217 ;

 0.10285265289355884034128563671 ; 0.10285265289355884034128563671 ; 0.10176238974840550459642895217 ; 0.09959342058679526706278028210 ; 0.09636873717464425963946862635 ;

 0.09212252223778612871763270709 ; 0.08689978720108297980238753072 ; 0.08075589522942021535469493846 ; 0.07375597473770520626824385002 ; 0.06597422988218049512812851512 ;

 0.057493156217619066481721689402 ; 0.048402672830594052902938140423 ; 0.038799192569627049596801936446 ; 0.028784707883323369349719179611 ; 0.018466468311090959142302131912 ;

 0.007968192496166605615465883475 |] ;;





let gauss_legendre_31_x = [| -0.99708748181947707405562655 ; -0.98468590966515248400246517 ; -0.96250392509294966178905240 ; -0.93075699789664816495694576 ;

 -0.88976002994827104337419201 ; -0.83992032014626734008690454 ; -0.78173314841662494040636002 ; -0.71577678458685328390597087 ; -0.64270672292426034618441820 ;

 -0.56324916140714926272094492 ; -0.47819378204490248044059404 ; -0.38838590160823294306135146 ; -0.29471806998170161661790390 ; -0.19812119933557062877241300 ;

 -0.09955531215234152032517479 ; 0.0 ; 0.09955531215234152032517479 ; 0.19812119933557062877241300 ; 0.29471806998170161661790390 ; 0.38838590160823294306135146 ;

 0.47819378204490248044059404 ; 0.56324916140714926272094492 ; 0.64270672292426034618441820 ; 0.71577678458685328390597087 ; 0.78173314841662494040636002 ;

 0.83992032014626734008690454 ; 0.88976002994827104337419201 ; 0.93075699789664816495694576 ; 0.96250392509294966178905240 ; 0.98468590966515248400246517 ;

 0.99708748181947707405562655 |] ;;



let gauss_legendre_31_w = [| 0.0074708315792487758586968750322 ; 0.017318620790310582463157996087 ; 0.027009019184979421800608708092 ; 0.036432273912385464024392010468 ;

 0.045493707527201102902315857895 ; 0.054103082424916853711666259087 ; 0.062174786561028426910343543687 ; 0.069628583235410366167756126255 ; 0.076390386598776616426357674901 ;

 0.082392991761589263903823367432 ; 0.087576740608477876126198069695 ; 0.091890113893641478215362871607 ; 0.095290242912319512807204197488 ; 0.097743335386328725093474010979 ;

 0.099225011226672307874875514429 ; 0.09972054479342645142753383373 ; 0.099225011226672307874875514429 ; 0.097743335386328725093474010979 ; 0.095290242912319512807204197488 ;

 0.091890113893641478215362871607 ; 0.087576740608477876126198069695 ; 0.082392991761589263903823367432 ; 0.076390386598776616426357674901 ; 0.069628583235410366167756126255 ;

 0.062174786561028426910343543687 ; 0.054103082424916853711666259087 ; 0.045493707527201102902315857895 ; 0.036432273912385464024392010468 ; 0.027009019184979421800608708092 ;

 0.017318620790310582463157996087 ; 0.0074708315792487758586968750322 |] ;;





let gauss_legendre_32_x = [| -0.99726386184948156354498113 ; -0.98561151154526833540017504 ; -0.96476225558750643077381193 ; -0.93490607593773968917091913 ;

 -0.89632115576605212396530724 ; -0.84936761373256997013369300 ; -0.79448379596794240696309730 ; -0.73218211874028968038742667 ; -0.66304426693021520097511517 ;

 -0.58771575724076232904074548 ; -0.50689990893222939002374747 ; -0.42135127613063534536411944 ; -0.33186860228212764977991681 ; -0.23928736225213707454460321 ;

 -0.14447196158279649348518637 ; -0.04830766568773831623481257 ; 0.04830766568773831623481257 ; 0.14447196158279649348518637 ; 0.23928736225213707454460321 ;

 0.33186860228212764977991681 ; 0.42135127613063534536411944 ; 0.50689990893222939002374747 ; 0.58771575724076232904074548 ; 0.66304426693021520097511517 ;

 0.73218211874028968038742667 ; 0.79448379596794240696309730 ; 0.84936761373256997013369300 ; 0.89632115576605212396530724 ; 0.93490607593773968917091913 ;

 0.96476225558750643077381193 ; 0.98561151154526833540017504 ; 0.99726386184948156354498113 |] ;;



let gauss_legendre_32_w = [| 0.007018610009470096600407063739 ; 0.016274394730905670605170562206 ; 0.025392065309262059455752589789 ; 0.034273862913021433102687732252 ;

 0.042835898022226680656878646606 ; 0.050998059262376176196163244690 ; 0.058684093478535547145283637300 ; 0.06582222277636184683765006371 ; 0.07234579410884850622539935648 ;

 0.07819389578707030647174091883 ; 0.08331192422694675522219907460 ; 0.08765209300440381114277146275 ; 0.09117387869576388471286857711 ; 0.09384439908080456563918023767 ;

 0.09563872007927485941908200220 ; 0.09654008851472780056676483006 ; 0.09654008851472780056676483006 ; 0.09563872007927485941908200220 ; 0.09384439908080456563918023767 ;

 0.09117387869576388471286857711 ; 0.08765209300440381114277146275 ; 0.08331192422694675522219907460 ; 0.07819389578707030647174091883 ; 0.07234579410884850622539935648 ;

 0.06582222277636184683765006371 ; 0.058684093478535547145283637300 ; 0.050998059262376176196163244690 ; 0.042835898022226680656878646606 ; 0.034273862913021433102687732252 ;

 0.025392065309262059455752589789 ; 0.016274394730905670605170562206 ; 0.007018610009470096600407063739 |] ;;





let gauss_legendre_33_x = [| -0.99742469424645521726616802 ; -0.98645572623064248811037570 ; -0.96682290968999276892837771 ; -0.93869437261116835035583512 ;

 -0.90231676774343358304053133 ; -0.85800965267650406464306148 ; -0.80616235627416658979620087 ; -0.74723049644956215785905512 ; -0.68173195996974278626821595 ;

 -0.61024234583637902730728751 ; -0.53338990478634764354889426 ; -0.45185001727245069572599328 ; -0.36633925774807334107022062 ; -0.27760909715249702940324807 ;

 -0.18643929882799157233579876 ; -0.09363106585473338567074292 ; 0.0 ; 0.09363106585473338567074292 ; 0.18643929882799157233579876 ; 0.27760909715249702940324807 ;

 0.36633925774807334107022062 ; 0.45185001727245069572599328 ; 0.53338990478634764354889426 ; 0.61024234583637902730728751 ; 0.68173195996974278626821595 ;

 0.74723049644956215785905512 ; 0.80616235627416658979620087 ; 0.85800965267650406464306148 ; 0.90231676774343358304053133 ; 0.93869437261116835035583512 ;

 0.96682290968999276892837771 ; 0.98645572623064248811037570 ; 0.99742469424645521726616802 |] ;;



let gauss_legendre_33_w = [| 0.0066062278475873780586492352085 ; 0.015321701512934676127945768534 ; 0.023915548101749480350533257529 ; 0.032300358632328953281561447250 ;

 0.040401541331669591563409790527 ; 0.048147742818711695670146880138 ; 0.055470846631663561284944495439 ; 0.062306482530317480031627725771 ; 0.068594572818656712805955073015 ;

 0.074279854843954149342472175919 ; 0.079312364794886738363908384942 ; 0.083647876067038707613928014518 ; 0.087248287618844337607281670945 ; 0.090081958660638577239743705500 ;

 0.092123986643316846213240977717 ; 0.093356426065596116160999126274 ; 0.09376844616020999656730454155 ; 0.093356426065596116160999126274 ; 0.092123986643316846213240977717 ;

 0.090081958660638577239743705500 ; 0.087248287618844337607281670945 ; 0.083647876067038707613928014518 ; 0.079312364794886738363908384942 ; 0.074279854843954149342472175919 ;

 0.068594572818656712805955073015 ; 0.062306482530317480031627725771 ; 0.055470846631663561284944495439 ; 0.048147742818711695670146880138 ; 0.040401541331669591563409790527 ;

 0.032300358632328953281561447250 ; 0.023915548101749480350533257529 ; 0.015321701512934676127945768534 ; 0.0066062278475873780586492352085 |] ;;





let gauss_legendre_63_x = [| -0.99928298402912378037893614 ; -0.99622401277797010860219336 ; -0.99072854689218946681089467 ; -0.98280881059372723486251141 ;

 -0.97248403469757002280196068 ; -0.95977944975894192707035417 ; -0.94472613404100980296637532 ; -0.92736092062184320544703138 ; -0.90772630277853155803695313 ;

 -0.88587032850785342629029846 ; -0.86184648236412371953961184 ; -0.83571355431950284347180777 ; -0.80753549577345676005146599 ; -0.7773812629903723355633302 ;

 -0.7453246483178474178293217 ; -0.7114440995848458078514315 ; -0.6758225281149860901311033 ; -0.6385471058213653850003070 ; -0.5997090518776252357390089 ;

 -0.5594034094862850132676978 ; -0.5177288132900332481244776 ; -0.4747872479948043999222123 ; -0.4306837987951116006620889 ; -0.3855263942122478924776150 ;

 -0.3394255419745844024688344 ; -0.2924940585862514400361572 ; -0.2448467932459533627484046 ; -0.1966003467915066845576275 ; -0.1478727863578719685698391 ;

 -0.0987833564469452795297037 ; -0.0494521871161596272342338 ; 0.0 ; 0.0494521871161596272342338 ; 0.0987833564469452795297037 ; 0.1478727863578719685698391 ;

 0.1966003467915066845576275 ; 0.2448467932459533627484046 ; 0.2924940585862514400361572 ; 0.3394255419745844024688344 ; 0.3855263942122478924776150 ;

 0.4306837987951116006620889 ; 0.4747872479948043999222123 ; 0.5177288132900332481244776 ; 0.5594034094862850132676978 ; 0.5997090518776252357390089 ;

 0.6385471058213653850003070 ; 0.6758225281149860901311033 ; 0.7114440995848458078514315 ; 0.7453246483178474178293217 ; 0.7773812629903723355633302 ;

 0.8075354957734567600514660 ; 0.8357135543195028434718078 ; 0.8618464823641237195396118 ; 0.8858703285078534262902985 ; 0.9077263027785315580369531 ;

 0.9273609206218432054470314 ; 0.9447261340410098029663753 ; 0.9597794497589419270703542 ; 0.9724840346975700228019607 ; 0.9828088105937272348625114 ;

 0.9907285468921894668108947 ; 0.9962240127779701086021934 ; 0.9992829840291237803789361 |] ;;



let gauss_legendre_63_w = [| 0.0018398745955770841170924455540 ; 0.0042785083468637618660784110826 ; 0.0067102917659601362519069307298 ; 0.0091259686763266563540586454218 ;

 0.011519376076880041750750606149 ; 0.013884612616115610824866086368 ; 0.016215878410338338882283672975 ; 0.018507464460161270409260545805 ; 0.020753761258039090775341953421 ;

 0.022949271004889933148942319562 ; 0.025088620553344986618630138068 ; 0.027166574359097933225189839439 ; 0.029178047208280526945551502154 ; 0.031118116622219817508215988557 ;

 0.032982034883779341765683179672 ; 0.034765240645355877697180504643 ; 0.036463370085457289630452409788 ; 0.038072267584349556763638324928 ; 0.039587995891544093984807928149 ;

 0.041006845759666398635110037009 ; 0.042325345020815822982505485403 ; 0.043540267083027590798964315704 ; 0.044648638825941395370332669517 ; 0.045647747876292608685885992609 ;

 0.046535149245383696510395418747 ; 0.047308671312268919080604988339 ; 0.047966421137995131411052756195 ; 0.048506789097883847864090099146 ; 0.048928452820511989944709361549 ;

 0.049230380423747560785043116988 ; 0.049411833039918178967039646117 ; 0.04947236662393102088866936042 ; 0.049411833039918178967039646117 ; 0.049230380423747560785043116988 ;

 0.048928452820511989944709361549 ; 0.048506789097883847864090099146 ; 0.047966421137995131411052756195 ; 0.047308671312268919080604988339 ; 0.046535149245383696510395418747 ;

 0.045647747876292608685885992609 ; 0.044648638825941395370332669517 ; 0.043540267083027590798964315704 ; 0.042325345020815822982505485403 ; 0.041006845759666398635110037009 ;

 0.039587995891544093984807928149 ; 0.038072267584349556763638324928 ; 0.036463370085457289630452409788 ; 0.034765240645355877697180504643 ; 0.032982034883779341765683179672 ;

 0.031118116622219817508215988557 ; 0.029178047208280526945551502154 ; 0.027166574359097933225189839439 ; 0.025088620553344986618630138068 ; 0.022949271004889933148942319562 ;

 0.020753761258039090775341953421 ; 0.018507464460161270409260545805 ; 0.016215878410338338882283672975 ; 0.013884612616115610824866086368 ; 0.011519376076880041750750606149 ;

 0.0091259686763266563540586454218 ; 0.0067102917659601362519069307298 ; 0.0042785083468637618660784110826 ; 0.0018398745955770841170924455540 |] ;;

 



let gauss_legendre_64_x = [| -0.99930504173577213945690562 ; -0.99634011677195527934692450 ; -0.99101337147674432073938238 ; -0.98333625388462595693129930 ;

 -0.97332682778991096374185351 ; -0.96100879965205371891861412 ; -0.94641137485840281606248149 ; -0.92956917213193957582149015 ; -0.91052213707850280575638067 ;

 -0.88931544599511410585340404 ; -0.86599939815409281976078339 ; -0.8406292962525803627516915 ; -0.8132653151227975597419233 ; -0.7839723589433414076102205 ;

 -0.7528199072605318966118638 ; -0.7198818501716108268489402 ; -0.6852363130542332425635584 ; -0.6489654712546573398577612 ; -0.6111553551723932502488530 ;

 -0.5718956462026340342838781 ; -0.5312794640198945456580139 ; -0.4894031457070529574785263 ; -0.4463660172534640879849477 ; -0.4022701579639916036957668 ;

 -0.3572201583376681159504426 ; -0.3113228719902109561575127 ; -0.2646871622087674163739642 ; -0.2174236437400070841496487 ; -0.1696444204239928180373136 ;

 -0.1214628192961205544703765 ; -0.0729931217877990394495429 ; -0.0243502926634244325089558 ; 0.0243502926634244325089558 ; 0.0729931217877990394495429 ;

 0.1214628192961205544703765 ; 0.1696444204239928180373136 ; 0.2174236437400070841496487 ; 0.2646871622087674163739642 ; 0.3113228719902109561575127 ;

 0.3572201583376681159504426 ; 0.4022701579639916036957668 ; 0.4463660172534640879849477 ; 0.4894031457070529574785263 ; 0.5312794640198945456580139 ;

 0.5718956462026340342838781 ; 0.6111553551723932502488530 ; 0.6489654712546573398577612 ; 0.6852363130542332425635584 ; 0.7198818501716108268489402 ;

 0.7528199072605318966118638 ; 0.7839723589433414076102205 ; 0.8132653151227975597419233 ; 0.8406292962525803627516915 ; 0.8659993981540928197607834 ;

 0.8893154459951141058534040 ; 0.9105221370785028057563807 ; 0.9295691721319395758214902 ; 0.9464113748584028160624815 ; 0.9610087996520537189186141 ;

 0.9733268277899109637418535 ; 0.9833362538846259569312993 ; 0.9910133714767443207393824 ; 0.9963401167719552793469245 ; 0.9993050417357721394569056 |] ;;



let gauss_legendre_64_w = [| 0.0017832807216964329472960791450 ; 0.0041470332605624676352875357286 ; 0.006504457968978362856117360400 ; 0.008846759826363947723030914660 ;

 0.011168139460131128818590493019 ; 0.013463047896718642598060766686 ; 0.015726030476024719321965995298 ; 0.017951715775697343085045302001 ; 0.020134823153530209372340316729 ;

 0.022270173808383254159298330384 ; 0.024352702568710873338177550409 ; 0.026377469715054658671691792625 ; 0.028339672614259483227511305200 ; 0.030234657072402478867974059820 ;

 0.032057928354851553585467504348 ; 0.033805161837141609391565482111 ; 0.035472213256882383810693146715 ; 0.037055128540240046040415101810 ; 0.038550153178615629128962496947 ;

 0.039953741132720341386656926128 ; 0.041262563242623528610156297474 ; 0.042473515123653589007339767909 ; 0.043583724529323453376827860974 ; 0.044590558163756563060134710031 ;

 0.045491627927418144479770996971 ; 0.046284796581314417295953249232 ; 0.046968182816210017325326285755 ; 0.047540165714830308662282206944 ; 0.04799938859645830772812617987 ;

 0.04834476223480295716976952716 ; 0.04857546744150342693479906678 ; 0.04869095700913972038336539073 ; 0.04869095700913972038336539073 ; 0.04857546744150342693479906678 ;

 0.04834476223480295716976952716 ; 0.04799938859645830772812617987 ; 0.047540165714830308662282206944 ; 0.046968182816210017325326285755 ; 0.046284796581314417295953249232 ;

 0.045491627927418144479770996971 ; 0.044590558163756563060134710031 ; 0.043583724529323453376827860974 ; 0.042473515123653589007339767909 ; 0.041262563242623528610156297474 ;

 0.039953741132720341386656926128 ; 0.038550153178615629128962496947 ; 0.037055128540240046040415101810 ; 0.035472213256882383810693146715 ; 0.033805161837141609391565482111 ;

 0.032057928354851553585467504348 ; 0.030234657072402478867974059820 ; 0.028339672614259483227511305200 ; 0.026377469715054658671691792625 ; 0.024352702568710873338177550409 ;

 0.022270173808383254159298330384 ; 0.020134823153530209372340316729 ; 0.017951715775697343085045302001 ; 0.015726030476024719321965995298 ; 0.013463047896718642598060766686 ;

 0.011168139460131128818590493019 ; 0.008846759826363947723030914660 ; 0.006504457968978362856117360400 ; 0.0041470332605624676352875357286 ; 0.0017832807216964329472960791450 |] ;;





let gauss_legendre_65_x = [| -0.99932609707541287726569361 ; -0.99645094806184916305579494 ; -0.99128527617680166872182118 ; -0.98383981218703494137763778 ;

 -0.97413153983355116907496789 ; -0.96218275471805523771198375 ; -0.94802092816840750637376974 ; -0.93167862822874933796567699 ; -0.91319344054284626173654692 ;

 -0.89260788050473893142328554 ; -0.8699692949264070361941320 ; -0.8453297528999302839424500 ; -0.8187459259226514534339191 ; -0.7902789574921218430473804 ;

 -0.7599943224419997868739828 ; -0.7279616763294246790119737 ; -0.6942546952139916335526225 ; -0.6589509061936251330409408 ; -0.6221315090854002415825996 ;

 -0.5838811896604873133271545 ; -0.5442879248622271385455725 ; -0.5034427804550068823410431 ; -0.4614397015691450576978341 ; -0.4183752966234090092641990 ;

 -0.3743486151220660120087939 ; -0.3294609198374864076452867 ; -0.2838154539022487306176554 ; -0.2375172033464168065707124 ; -0.1906726556261427697749124 ;

 -0.1433895546989751711312496 ; -0.0957766532091975056522186 ; -0.0479434623531718575225298 ; 0.0 ; 0.0479434623531718575225298 ; 0.0957766532091975056522186 ;

 0.1433895546989751711312496 ; 0.1906726556261427697749124 ; 0.2375172033464168065707124 ; 0.2838154539022487306176554 ; 0.3294609198374864076452867 ;

 0.3743486151220660120087939 ; 0.4183752966234090092641990 ; 0.4614397015691450576978341 ; 0.5034427804550068823410431 ; 0.5442879248622271385455725 ;

 0.5838811896604873133271545 ; 0.6221315090854002415825996 ; 0.6589509061936251330409408 ; 0.6942546952139916335526225 ; 0.7279616763294246790119737 ;

 0.7599943224419997868739828 ; 0.7902789574921218430473804 ; 0.8187459259226514534339191 ; 0.8453297528999302839424500 ; 0.8699692949264070361941320 ;

 0.8926078805047389314232855 ; 0.9131934405428462617365469 ; 0.9316786282287493379656770 ; 0.9480209281684075063737697 ; 0.9621827547180552377119837 ;

 0.9741315398335511690749679 ; 0.9838398121870349413776378 ; 0.9912852761768016687218212 ; 0.9964509480618491630557949 ; 0.9993260970754128772656936 |] ;;



let gauss_legendre_65_w = [| 0.0017292582513002508983395851463 ; 0.0040215241720037363470786599528 ; 0.0063079425789717545501888719039 ; 0.0085801482668814598936358121592 ;

 0.0108326787895979686215140551272 ; 0.013060311639994846336168342922 ; 0.015257912146448310349265388145 ; 0.017420421997670248495365759969 ; 0.019542865836750062826837429313 ;

 0.021620361284934062841654274667 ; 0.023648129691287236698780978994 ; 0.025621506938037758214084978694 ; 0.027535954088450343942499722327 ; 0.029387067789310668062644859210 ;

 0.031170590380189142464431845777 ; 0.032882419676368574984049638008 ; 0.034518618398549058625221276859 ; 0.036075423225565273932166270524 ; 0.037549253448257709809772223198 ;

 0.038936719204051197616673806364 ; 0.040234629273005533815446337743 ; 0.041439998417240293022686299233 ; 0.042550054246755802719217150803 ; 0.043562243595800486532284821661 ;

 0.044474238395082974427323504000 ; 0.045283941026300230657128240574 ; 0.045989489146651696963893390818 ; 0.046589259972233498302255136790 ; 0.047081874010454522246006808290 ;

 0.047466198232885503152644458740 ; 0.047741348681240621559038972227 ; 0.047906692500495862031347289176 ; 0.04796184939446661812070762137 ; 0.047906692500495862031347289176 ;

 0.047741348681240621559038972227 ; 0.047466198232885503152644458740 ; 0.047081874010454522246006808290 ; 0.046589259972233498302255136790 ; 0.045989489146651696963893390818 ;

 0.045283941026300230657128240574 ; 0.044474238395082974427323504000 ; 0.043562243595800486532284821661 ; 0.042550054246755802719217150803 ; 0.041439998417240293022686299233 ;

 0.040234629273005533815446337743 ; 0.038936719204051197616673806364 ; 0.037549253448257709809772223198 ; 0.036075423225565273932166270524 ; 0.034518618398549058625221276859 ;

 0.032882419676368574984049638008 ; 0.031170590380189142464431845777 ; 0.029387067789310668062644859210 ; 0.027535954088450343942499722327 ; 0.025621506938037758214084978694 ;

 0.023648129691287236698780978994 ; 0.021620361284934062841654274667 ; 0.019542865836750062826837429313 ; 0.017420421997670248495365759969 ; 0.015257912146448310349265388145 ;

 0.013060311639994846336168342922 ; 0.0108326787895979686215140551272 ; 0.0085801482668814598936358121592 ; 0.0063079425789717545501888719039 ; 0.0040215241720037363470786599528 ;

 0.0017292582513002508983395851463 |] ;;

    

  

let gauss_legendre_127_x = [| -0.9998221304153061462673512 ; -0.9990629343553118951383159 ; -0.9976975661898046210744170 ; -0.9957265513520272266354334 ;

 -0.9931510492545171473611308 ; -0.9899726145914841576077867 ; -0.9861931740169316667104383 ; -0.9818150208038141100334631 ; -0.9768408123430703268174439 ;

 -0.9712735681615291922889469 ; -0.9651166679452921210908251 ; -0.9583738494252387711491029 ; -0.9510492060778803105479076 ; -0.9431471846248148273454496 ;

 -0.9346725823247379685736349 ; -0.9256305440562338491274647 ; -0.9160265591914658093130886 ; -0.9058664582618213828024613 ; -0.8951564094170837089690438 ;

 -0.8839029146800265699452579 ; -0.8721128059985607114196375 ; -0.8597932410977408098120313 ; -0.8469516991340975984533393 ; -0.8335959761548995143795572 ;

 -0.8197341803650786741551191 ; -0.8053747272046802146665608 ; -0.7905263342398137999454500 ; -0.7751980158702023824449628 ; -0.7593990778565366715566637 ;

 -0.7431391116709545129205669 ; -0.7264279886740726855356929 ; -0.7092758541221045609994446 ; -0.6916931210077006701564414 ; -0.6736904637382504853466825 ;

 -0.6552788116554826302767651 ; -0.6364693424002972413476082 ; -0.6172734751268582838576392 ; -0.5977028635700652293844120 ; -0.5777693889706125800032517 ;

 -0.5574851528619322329218619 ; -0.5368624697233975674581664 ; -0.5159138595042493572772773 ; -0.4946520400227821173949402 ; -0.4730899192454052416450999 ;

 -0.4512405874502662273318986 ; -0.4291173092801933762625441 ; -0.4067335156897825634086729 ; -0.3841027957915169357790778 ; -0.3612388886058697060709248 ;

 -0.3381556747203985013760003 ; -0.3148671678628949814860148 ; -0.2913875063937056207945188 ; -0.2677309447223886208883435 ; -0.2439118446539178579707132 ;

 -0.2199446666696875424545234 ; -0.1958439611486108515042816 ; -0.1716243595336421650083449 ; -0.1473005654490856693893293 ; -0.1228873457740829717260337 ;

 -0.0983995216776989707510918 ; -0.0738519596210485452734404 ; -0.0492595623319266303153793 ; -0.0246372597574209446148971 ; 0.0 ; 0.0246372597574209446148971 ;

 0.0492595623319266303153793 ; 0.0738519596210485452734404 ; 0.0983995216776989707510918 ; 0.1228873457740829717260337 ; 0.1473005654490856693893293 ;

 0.1716243595336421650083449 ; 0.1958439611486108515042816 ; 0.2199446666696875424545234 ; 0.2439118446539178579707132 ; 0.2677309447223886208883435 ;

 0.2913875063937056207945188 ; 0.3148671678628949814860148 ; 0.3381556747203985013760003 ; 0.3612388886058697060709248 ; 0.3841027957915169357790778 ;

 0.4067335156897825634086729 ; 0.4291173092801933762625441 ; 0.4512405874502662273318986 ; 0.4730899192454052416450999 ; 0.4946520400227821173949402 ;

 0.5159138595042493572772773 ; 0.5368624697233975674581664 ; 0.5574851528619322329218619 ; 0.5777693889706125800032517 ; 0.5977028635700652293844120 ;

 0.6172734751268582838576392 ; 0.6364693424002972413476082 ; 0.6552788116554826302767651 ; 0.6736904637382504853466825 ; 0.6916931210077006701564414 ;

 0.7092758541221045609994446 ; 0.7264279886740726855356929 ; 0.7431391116709545129205669 ; 0.7593990778565366715566637 ; 0.7751980158702023824449628 ;

 0.7905263342398137999454500 ; 0.8053747272046802146665608 ; 0.8197341803650786741551191 ; 0.8335959761548995143795572 ; 0.8469516991340975984533393 ;

 0.8597932410977408098120313 ; 0.8721128059985607114196375 ; 0.8839029146800265699452579 ; 0.8951564094170837089690438 ; 0.9058664582618213828024613 ;

 0.9160265591914658093130886 ; 0.9256305440562338491274647 ; 0.9346725823247379685736349 ; 0.9431471846248148273454496 ; 0.9510492060778803105479076 ;

 0.9583738494252387711491029 ; 0.965116667945292121090825 ; 0.971273568161529192288947 ; 0.976840812343070326817444 ; 0.981815020803814110033463 ;

 0.986193174016931666710438 ; 0.989972614591484157607787 ; 0.993151049254517147361131 ; 0.995726551352027226635433 ; 0.997697566189804621074417 ;

 0.999062934355311895138316 ; 0.999822130415306146267351 |] ;;



let gauss_legendre_127_w = [| 0.00045645726109586662791936519265 ; 0.00106227668695384869596523598532 ; 0.0016683488125171936761028862915 ; 0.0022734860707492547802810840776 ;

 0.0028772587656289004082883197514 ; 0.0034792893810051465908910894100 ; 0.0040792095178254605327114733457 ; 0.0046766539777779034772638165663 ; 0.0052712596565634400891303815906 ;

 0.0058626653903523901033648343751 ; 0.0064505120486899171845442463869 ; 0.0070344427036681608755685893033 ; 0.0076141028256526859356393930849 ; 0.0081891404887415730817235884719 ;

 0.0087592065795403145773316804234 ; 0.0093239550065309714787536985834 ; 0.0098830429087554914716648010900 ; 0.0104361308631410052256731719977 ; 0.0109828830900689757887996573761 ;

 0.011522967656921087154811609735 ; 0.012056056679400848183529562145 ; 0.012581826520465013101514365424 ; 0.013099957986718627426172681913 ; 0.013610136522139249906034237534 ;

 0.014112052399003395774044161634 ; 0.014605400905893418351737288079 ; 0.015089882532666922992635733981 ; 0.015565203152273955098532590263 ; 0.016031074199309941802254151843 ;

 0.016487212845194879399346060358 ; 0.016933342169871654545878815295 ; 0.017369191329918731922164721250 ; 0.017794495722974774231027912900 ; 0.018208997148375106468721469154 ;

 0.018612443963902310429440419899 ; 0.019004591238555646611148901045 ; 0.019385200901246454628112623489 ; 0.019754041885329183081815217323 ; 0.020110890268880247225644623956 ;

 0.020455529410639508279497065713 ; 0.020787750081531811812652137291 ; 0.021107350591688713643523847922 ; 0.021414136912893259295449693234 ; 0.021707922796373466052301324695 ;

 0.021988529885872983756478409759 ; 0.022255787825930280235631416460 ; 0.022509534365300608085694429903 ; 0.022749615455457959852242553241 ; 0.022975885344117206754377437839 ;

 0.023188206663719640249922582982 ; 0.023386450514828194170722043497 ; 0.023570496544381716050033676844 ; 0.023740233018760777777714726703 ; 0.023895556891620665983864481754 ;

 0.024036373866450369675132086026 ; 0.024162598453819584716522917711 ; 0.024274154023278979833195063937 ; 0.024370972849882214952813561907 ; 0.024452996155301467956140198472 ;

 0.024520174143511508275183033290 ; 0.024572466031020653286354137335 ; 0.024609840071630254092545634003 ; 0.024632273575707679066033370218 ; 0.02463975292396109441957941748 ;

 0.024632273575707679066033370218 ; 0.024609840071630254092545634003 ; 0.024572466031020653286354137335 ; 0.024520174143511508275183033290 ; 0.024452996155301467956140198472 ;

 0.024370972849882214952813561907 ; 0.024274154023278979833195063937 ; 0.024162598453819584716522917711 ; 0.024036373866450369675132086026 ; 0.023895556891620665983864481754 ;

 0.023740233018760777777714726703 ; 0.023570496544381716050033676844 ; 0.023386450514828194170722043497 ; 0.023188206663719640249922582982 ; 0.022975885344117206754377437839 ;

 0.022749615455457959852242553241 ; 0.022509534365300608085694429903 ; 0.022255787825930280235631416460 ; 0.021988529885872983756478409759 ; 0.021707922796373466052301324695 ;

 0.021414136912893259295449693234 ; 0.021107350591688713643523847922 ; 0.020787750081531811812652137291 ; 0.020455529410639508279497065713 ; 0.020110890268880247225644623956 ;

 0.019754041885329183081815217323 ; 0.019385200901246454628112623489 ; 0.019004591238555646611148901045 ; 0.018612443963902310429440419899 ; 0.018208997148375106468721469154 ;

 0.017794495722974774231027912900 ; 0.017369191329918731922164721250 ; 0.016933342169871654545878815295 ; 0.016487212845194879399346060358 ; 0.016031074199309941802254151843 ;

 0.015565203152273955098532590263 ; 0.015089882532666922992635733981 ; 0.014605400905893418351737288079 ; 0.014112052399003395774044161634 ; 0.013610136522139249906034237534 ;

 0.013099957986718627426172681913 ; 0.012581826520465013101514365424 ; 0.012056056679400848183529562145 ; 0.011522967656921087154811609735 ; 0.0109828830900689757887996573761 ;

 0.0104361308631410052256731719977 ; 0.0098830429087554914716648010900 ; 0.0093239550065309714787536985834 ; 0.0087592065795403145773316804234 ; 0.0081891404887415730817235884719 ;

 0.0076141028256526859356393930849 ; 0.0070344427036681608755685893033 ; 0.0064505120486899171845442463869 ; 0.0058626653903523901033648343751 ; 0.0052712596565634400891303815906 ;

 0.0046766539777779034772638165663 ; 0.0040792095178254605327114733457 ; 0.0034792893810051465908910894100 ; 0.0028772587656289004082883197514 ; 0.0022734860707492547802810840776 ;

 0.0016683488125171936761028862915 ; 0.00106227668695384869596523598532 ; 0.00045645726109586662791936519265 |] ;;

 



let gauss_legendre_128_x = [| -0.9998248879471319144736081 ; -0.9990774599773758950119878 ; -0.9977332486255140198821574 ; -0.9957927585349811868641612 ;

 -0.9932571129002129353034372 ; -0.9901278184917343833379303 ; -0.9864067427245862088712355 ; -0.9820961084357185360247656 ; -0.9771984914639073871653744 ;

 -0.9717168187471365809043384 ; -0.9656543664319652686458290 ; -0.9590147578536999280989185 ; -0.9518019613412643862177963 ; -0.9440202878302201821211114 ;

 -0.9356743882779163757831268 ; -0.9267692508789478433346245 ; -0.9173101980809605370364836 ; -0.9073028834017568139214859 ; -0.8967532880491581843864474 ;

 -0.8856677173453972174082924 ; -0.8740527969580317986954180 ; -0.8619154689395484605906323 ; -0.8492629875779689691636001 ; -0.8361029150609068471168753 ;

 -0.8224431169556438424645942 ; -0.8082917575079136601196422 ; -0.7936572947621932902433329 ; -0.7785484755064119668504941 ; -0.7629743300440947227797691 ;

 -0.7469441667970619811698824 ; -0.7304675667419088064717369 ; -0.7135543776835874133438599 ; -0.6962147083695143323850866 ; -0.6784589224477192593677557 ;

 -0.6602976322726460521059468 ; -0.6417416925623075571535249 ; -0.6228021939105849107615396 ; -0.6034904561585486242035732 ; -0.5838180216287630895500389 ;

 -0.5637966482266180839144308 ; -0.5434383024128103634441936 ; -0.5227551520511754784539479 ; -0.5017595591361444642896063 ; -0.4804640724041720258582757 ;

 -0.4588814198335521954490891 ; -0.4370245010371041629370429 ; -0.4149063795522750154922739 ; -0.3925402750332674427356482 ; -0.3699395553498590266165917 ;

 -0.3471177285976355084261628 ; -0.3240884350244133751832523 ; -0.3008654388776772026671541 ; -0.2774626201779044028062316 ; -0.2538939664226943208556180 ;

 -0.2301735642266599864109866 ; -0.2063155909020792171540580 ; -0.1823343059853371824103826 ; -0.1582440427142249339974755 ; -0.1340591994611877851175753 ;

 -0.1097942311276437466729747 ; -0.0854636405045154986364980 ; -0.0610819696041395681037870 ; -0.0366637909687334933302153 ; -0.0122236989606157641980521 ;

 0.0122236989606157641980521 ; 0.0366637909687334933302153 ; 0.0610819696041395681037870 ; 0.0854636405045154986364980 ; 0.1097942311276437466729747 ;

 0.1340591994611877851175753 ; 0.1582440427142249339974755 ; 0.1823343059853371824103826 ; 0.2063155909020792171540580 ; 0.2301735642266599864109866 ;

 0.2538939664226943208556180 ; 0.2774626201779044028062316 ; 0.3008654388776772026671541 ; 0.3240884350244133751832523 ; 0.3471177285976355084261628 ;

 0.3699395553498590266165917 ; 0.3925402750332674427356482 ; 0.4149063795522750154922739 ; 0.4370245010371041629370429 ; 0.4588814198335521954490891 ;

 0.4804640724041720258582757 ; 0.5017595591361444642896063 ; 0.5227551520511754784539479 ; 0.5434383024128103634441936 ; 0.5637966482266180839144308 ;

 0.5838180216287630895500389 ; 0.6034904561585486242035732 ; 0.6228021939105849107615396 ; 0.6417416925623075571535249 ; 0.6602976322726460521059468 ;

 0.6784589224477192593677557 ; 0.6962147083695143323850866 ; 0.7135543776835874133438599 ; 0.7304675667419088064717369 ; 0.7469441667970619811698824 ;

 0.7629743300440947227797691 ; 0.7785484755064119668504941 ; 0.7936572947621932902433329 ; 0.8082917575079136601196422 ; 0.8224431169556438424645942 ;

 0.8361029150609068471168753 ; 0.8492629875779689691636001 ; 0.8619154689395484605906323 ; 0.8740527969580317986954180 ; 0.8856677173453972174082924 ;

 0.8967532880491581843864474 ; 0.9073028834017568139214859 ; 0.9173101980809605370364836 ; 0.926769250878947843334625 ; 0.935674388277916375783127 ;

 0.944020287830220182121111 ; 0.951801961341264386217796 ; 0.959014757853699928098919 ; 0.965654366431965268645829 ; 0.971716818747136580904338 ;

 0.977198491463907387165374 ; 0.982096108435718536024766 ; 0.986406742724586208871236 ; 0.990127818491734383337930 ; 0.993257112900212935303437 ;

 0.995792758534981186864161 ; 0.997733248625514019882157 ; 0.999077459977375895011988 ; 0.999824887947131914473608 |] ;;



let gauss_legendre_128_w = [| 0.00044938096029209037639429223999 ; 0.0010458126793403487793128516001 ; 0.0016425030186690295387908755948 ; 0.0022382884309626187436220542727 ;

 0.0028327514714579910952857346468 ; 0.0034255260409102157743377846601 ; 0.0040162549837386423131943434863 ; 0.0046045842567029551182905419803 ; 0.0051901618326763302050707671348 ;

 0.0057726375428656985893346176261 ; 0.006351663161707188787214327826 ; 0.006926892566898813563426670360 ; 0.007497981925634728687671962688 ; 0.008064589890486057972928598698 ;

 0.008626377798616749704978843782 ; 0.009183009871660874334478743688 ; 0.009734153415006805863548266094 ; 0.010279479015832157133215340326 ; 0.010818660739503076247659646277 ;

 0.011351376324080416693281668453 ; 0.011877307372740279575891106926 ; 0.012396139543950922968821728197 ; 0.012907562739267347220442834004 ; 0.013411271288616332314488951616 ;

 0.013906964132951985244288007396 ; 0.014394345004166846176823892009 ; 0.014873122602147314252385498520 ; 0.015343010768865144085990853741 ; 0.015803728659399346858965631687 ;

 0.016255000909785187051657456477 ; 0.016696557801589204589091507954 ; 0.017128135423111376830680987619 ; 0.017549475827117704648706925634 ; 0.017960327185008685940196927525 ;

 0.018360443937331343221289290991 ; 0.018749586940544708650919548474 ; 0.019127523609950945486518531668 ; 0.019494028058706602823021918681 ; 0.019848881232830862219944413265 ;

 0.020191871042130041180673158406 ; 0.020522792486960069432284967788 ; 0.020841447780751149113583948423 ; 0.021147646468221348537019535180 ; 0.021441205539208460137111853878 ;

 0.021721949538052075375260957768 ; 0.021989710668460491434122106599 ; 0.022244328893799765104629133607 ; 0.022485652032744966871824603941 ; 0.022713535850236461309712635923 ;

 0.022927844143686846920410987209 ; 0.023128448824387027879297902403 ; 0.023315229994062760122415671273 ; 0.023488076016535913153025273282 ; 0.023646883584447615143651392303 ;

 0.023791557781003400638780709885 ; 0.023922012136703455672450408817 ; 0.024038168681024052637587316820 ; 0.024139957989019284997716653890 ; 0.024227319222815248120093308442 ;

 0.024300200167971865323442606364 ; 0.024358557264690625853268520246 ; 0.024402355633849582093297989694 ; 0.02443156909785004505484856143 ; 0.02444618019626251821132585261 ;

 0.02444618019626251821132585261 ; 0.02443156909785004505484856143 ; 0.024402355633849582093297989694 ; 0.024358557264690625853268520246 ; 0.024300200167971865323442606364 ;

 0.024227319222815248120093308442 ; 0.024139957989019284997716653890 ; 0.024038168681024052637587316820 ; 0.023922012136703455672450408817 ; 0.023791557781003400638780709885 ;

 0.023646883584447615143651392303 ; 0.023488076016535913153025273282 ; 0.023315229994062760122415671273 ; 0.023128448824387027879297902403 ; 0.022927844143686846920410987209 ;

 0.022713535850236461309712635923 ; 0.022485652032744966871824603941 ; 0.022244328893799765104629133607 ; 0.021989710668460491434122106599 ; 0.021721949538052075375260957768 ;

 0.021441205539208460137111853878 ; 0.021147646468221348537019535180 ; 0.020841447780751149113583948423 ; 0.020522792486960069432284967788 ; 0.020191871042130041180673158406 ;

 0.019848881232830862219944413265 ; 0.019494028058706602823021918681 ; 0.019127523609950945486518531668 ; 0.018749586940544708650919548474 ; 0.018360443937331343221289290991 ;

 0.017960327185008685940196927525 ; 0.017549475827117704648706925634 ; 0.017128135423111376830680987619 ; 0.016696557801589204589091507954 ; 0.016255000909785187051657456477 ;

 0.015803728659399346858965631687 ; 0.015343010768865144085990853741 ; 0.014873122602147314252385498520 ; 0.014394345004166846176823892009 ; 0.013906964132951985244288007396 ;

 0.013411271288616332314488951616 ; 0.012907562739267347220442834004 ; 0.012396139543950922968821728197 ; 0.011877307372740279575891106926 ; 0.011351376324080416693281668453 ;

 0.010818660739503076247659646277 ; 0.010279479015832157133215340326 ; 0.009734153415006805863548266094 ; 0.009183009871660874334478743688 ; 0.008626377798616749704978843782 ;

 0.008064589890486057972928598698 ; 0.007497981925634728687671962688 ; 0.006926892566898813563426670360 ; 0.006351663161707188787214327826 ; 0.0057726375428656985893346176261 ;

 0.0051901618326763302050707671348 ; 0.0046045842567029551182905419803 ; 0.0040162549837386423131943434863 ; 0.0034255260409102157743377846601 ; 0.0028327514714579910952857346468 ;

 0.0022382884309626187436220542727 ; 0.0016425030186690295387908755948 ; 0.0010458126793403487793128516001 ; 0.00044938096029209037639429223999 |] ;;





let gauss_legendre_129_x = [| -0.9998275818477487191077441 ; -0.9990916504696409986514389 ; -0.9977681080525852721429460 ; -0.9958574393142831982149111 ;

 -0.9933607326210712814854011 ; -0.9902794486488178389207689 ; -0.9866153978313475022005761 ; -0.9823707352517413115507418 ; -0.9775479582993672474447814 ;

 -0.9721499048427034297274163 ; -0.9661797514202097197778763 ; -0.9596410113101918904168119 ; -0.9525375324342090471027732 ; -0.9448734950776734726784764 ;

 -0.9366534094216514605284616 ; -0.9278821128840036204317296 ; -0.9185647672698286252225115 ; -0.9087068557320696331245539 ; -0.8983141795436338850435985 ;

 -0.8873928546826803665034968 ; -0.8759493082329433892035217 ; -0.8639902746011257878940216 ; -0.8515227915535356930243826 ; -0.8385541960742664442975407 ;

 -0.8250921200473358809210133 ; -0.8111444857653120742087717 ; -0.7967195012670592680339606 ; -0.7818256555073413245387500 ; -0.7664717133611208816717785 ;

 -0.7506667104654910227632368 ; -0.7344199479022727047791516 ; -0.7177409867244055767721220 ; -0.7006396423293521790044710 ; -0.6831259786828258512462248 ;

 -0.6652103023962409818802202 ; -0.6469031566613704719753373 ; -0.6282153150457794374886895 ; -0.6091577751526861909563306 ; -0.5897417521489813916767844 ;

 -0.5699786721652138894754096 ; -0.5498801655714271702189358 ; -0.5294580601328034000099406 ; -0.5087243740491428186199463 ; -0.4876913088822746111853066 ;

 -0.4663712423755613514331869 ; -0.4447767211697226217818454 ; -0.4229204534192644388475065 ; -0.4008153013138596117693121 ; -0.3784742735090801012801265 ;

 -0.3559105174709357969672656 ; -0.3331373117387248575049982 ; -0.3101680581107488341147318 ; -0.2870162737574911929568755 ; -0.2636955832669005409666949 ;

 -0.2402197106264598167721148 ; -0.2166024711467599103221439 ; -0.1928577633313305998663880 ; -0.1689995606975133227390302 ; -0.1450419035531891084328306 ;

 -0.1209988907342009817690539 ; -0.0968846713073332753086909 ; -0.0727134362437305599118207 ; -0.0484994100676562986191764 ; -0.0242568424855058415749954 ;

 0.0 ; 0.0242568424855058415749954 ; 0.0484994100676562986191764 ; 0.0727134362437305599118207 ; 0.0968846713073332753086909 ; 0.1209988907342009817690539 ;

 0.1450419035531891084328306 ; 0.1689995606975133227390302 ; 0.1928577633313305998663880 ; 0.2166024711467599103221439 ; 0.2402197106264598167721148 ;

 0.2636955832669005409666949 ; 0.2870162737574911929568755 ; 0.3101680581107488341147318 ; 0.3331373117387248575049982 ; 0.3559105174709357969672656 ;

 0.3784742735090801012801265 ; 0.4008153013138596117693121 ; 0.4229204534192644388475065 ; 0.4447767211697226217818454 ; 0.4663712423755613514331869 ;

 0.4876913088822746111853066 ; 0.5087243740491428186199463 ; 0.5294580601328034000099406 ; 0.5498801655714271702189358 ; 0.5699786721652138894754096 ;

 0.5897417521489813916767844 ; 0.6091577751526861909563306 ; 0.6282153150457794374886895 ; 0.6469031566613704719753373 ; 0.6652103023962409818802202 ;

 0.6831259786828258512462248 ; 0.7006396423293521790044710 ; 0.7177409867244055767721220 ; 0.7344199479022727047791516 ; 0.7506667104654910227632368 ;

 0.7664717133611208816717785 ; 0.7818256555073413245387500 ; 0.7967195012670592680339606 ; 0.8111444857653120742087717 ; 0.8250921200473358809210133 ;

 0.8385541960742664442975407 ; 0.8515227915535356930243826 ; 0.8639902746011257878940216 ; 0.875949308232943389203522 ; 0.887392854682680366503497 ;

 0.898314179543633885043599 ; 0.908706855732069633124554 ; 0.918564767269828625222511 ; 0.927882112884003620431730 ; 0.936653409421651460528462 ;

 0.944873495077673472678476 ; 0.952537532434209047102773 ; 0.959641011310191890416812 ; 0.966179751420209719777876 ; 0.972149904842703429727416 ;

 0.977547958299367247444781 ; 0.982370735251741311550742 ; 0.986615397831347502200576 ; 0.990279448648817838920769 ; 0.993360732621071281485401 ;

 0.995857439314283198214911 ; 0.997768108052585272142946 ; 0.999091650469640998651439 ; 0.999827581847748719107744 |] ;;



let gauss_legendre_129_w = [| 0.00044246794182939296923668005717 ; 0.00102972844619622394463273519315 ; 0.0016172530556785534682413679271 ; 0.0022039015180966937075786419741 ;

 0.0027892681877797554940944677057 ; 0.0033729979506246246117755709288 ; 0.0039547444682113562172392974765 ; 0.0045341644298525434513226874954 ; 0.0051109164669246267289761565766 ;

 0.0056846609912469045788016012203 ; 0.0062550602724461408889348709586 ; 0.0068217785893519121070498527769 ; 0.0073844824072454014447165055698 ; 0.0079428405646668029041114107832 ;

 0.0084965244635723279730542832506 ; 0.0090452082602137316404219313819 ; 0.0095885690555104190787301294510 ; 0.0101262870842733548093160774580 ; 0.0106580459029055185304204093001 ;

 0.0111835325753305049735380697538 ; 0.011702437856964778185746436834 ; 0.012214456376582979416221105914 ; 0.012719286815944623465099036330 ; 0.013216632087061724231482387345 ;

 0.013706199506993971244060563234 ; 0.014187700970062900419317230938 ; 0.014660853117380060971041027493 ; 0.015125377503587024690403432771 ; 0.015581000760707523415881287558 ;

 0.016027454759014214436403950465 ; 0.016464476764814667467169189640 ; 0.016891809595063204177526208819 ; 0.017309201768707240731293596444 ; 0.017716407654678809269702031810 ;

 0.018113187616443980503999783812 ; 0.018499308153024985727791918518 ; 0.018874542036411948181617592169 ; 0.019238668445283284085199492202 ; 0.019591473094956024580283987216 ;

 0.019932748363489542089706675388 ; 0.020262293413868438317104423081 ; 0.020579914312192665948185517085 ; 0.020885424141805311409990024684 ; 0.021178643113290860912881038703 ;

 0.021459398670279205389981598196 ; 0.021727525590993110687305178710 ; 0.021982866085479386179554968899 ; 0.022225269888466526554736910919 ; 0.022454594347794176432066564511 ;

 0.022670704508362374313093970958 ; 0.022873473191551169638592083492 ; 0.023062781070063872924670495006 ; 0.023238516738149892544490435771 ; 0.023400576777165831146714346635 ;

 0.023548865816436258377269094263 ; 0.023683296589378342897341543485 ; 0.023803789984857314051325299744 ; 0.023910275093742530302367230296 ; 0.024002689250636756075547029720 ;

 0.024080978070754089272959634041 ; 0.024145095481924836783843156014 ; 0.024195003751708503129818111597 ; 0.024230673509598936275508460625 ; 0.024252083764308562906498864071 ;

 0.02425922191612154143202867472 ; 0.024252083764308562906498864071 ; 0.024230673509598936275508460625 ; 0.024195003751708503129818111597 ; 0.024145095481924836783843156014 ;

 0.024080978070754089272959634041 ; 0.024002689250636756075547029720 ; 0.023910275093742530302367230296 ; 0.023803789984857314051325299744 ; 0.023683296589378342897341543485 ;

 0.023548865816436258377269094263 ; 0.023400576777165831146714346635 ; 0.023238516738149892544490435771 ; 0.023062781070063872924670495006 ; 0.022873473191551169638592083492 ;

 0.022670704508362374313093970958 ; 0.022454594347794176432066564511 ; 0.022225269888466526554736910919 ; 0.021982866085479386179554968899 ; 0.021727525590993110687305178710 ;

 0.021459398670279205389981598196 ; 0.021178643113290860912881038703 ; 0.020885424141805311409990024684 ; 0.020579914312192665948185517085 ; 0.020262293413868438317104423081 ;

 0.019932748363489542089706675388 ; 0.019591473094956024580283987216 ; 0.019238668445283284085199492202 ; 0.018874542036411948181617592169 ; 0.018499308153024985727791918518 ;

 0.018113187616443980503999783812 ; 0.017716407654678809269702031810 ; 0.017309201768707240731293596444 ; 0.016891809595063204177526208819 ; 0.016464476764814667467169189640 ;

 0.016027454759014214436403950465 ; 0.015581000760707523415881287558 ; 0.015125377503587024690403432771 ; 0.014660853117380060971041027493 ; 0.014187700970062900419317230938 ;

 0.013706199506993971244060563234 ; 0.013216632087061724231482387345 ; 0.012719286815944623465099036330 ; 0.012214456376582979416221105914 ; 0.011702437856964778185746436834 ;

 0.0111835325753305049735380697538 ; 0.0106580459029055185304204093001 ; 0.0101262870842733548093160774580 ; 0.0095885690555104190787301294510 ; 0.0090452082602137316404219313819 ;

 0.0084965244635723279730542832506 ; 0.0079428405646668029041114107832 ; 0.0073844824072454014447165055698 ; 0.0068217785893519121070498527769 ; 0.0062550602724461408889348709586 ;

 0.0056846609912469045788016012203 ; 0.0051109164669246267289761565766 ; 0.0045341644298525434513226874954 ; 0.0039547444682113562172392974765 ; 0.0033729979506246246117755709288 ;

 0.0027892681877797554940944677057 ; 0.0022039015180966937075786419741 ; 0.0016172530556785534682413679271 ; 0.00102972844619622394463273519315 ; 0.00044246794182939296923668005717 |] ;;





let gauss_legendre_255_x = [| -0.999955705317563751730191 ; -0.999766621312000569367063 ; -0.999426474680169959344386 ; -0.998935241284654635142155 ;

 -0.998292986136967889228248 ; -0.997499804126615814044844 ; -0.996555814435198617028738 ; -0.995461159480026294089975 ; -0.994216004616630164799381 ;

 -0.992820538021989138984811 ; -0.991274970630385567164523 ; -0.989579536085920123498574 ; -0.987734490699732356281248 ; -0.985740113407419277752900 ;

 -0.983596705724776358640192 ; -0.981304591701017185126565 ; -0.978864117869068155239121 ; -0.976275653192735980815246 ; -0.973539589010643617645393 ;

 -0.970656338976880365477697 ; -0.967626338998338798105523 ; -0.964450047168726298761719 ; -0.961127943699247839572910 ; -0.957660530845962076295490 ;

 -0.954048332833816317950921 ; -0.950291895777368285733522 ; -0.946391787598204251752103 ; -0.942348597939064408301480 ; -0.938162938074687317626793 ;

 -0.933835440819386124349338 ; -0.929366760431369935739045 ; -0.924757572513824425220425 ; -0.920008573912766315142721 ; -0.915120482611686961035103 ;

 -0.910094037623000801254172 ; -0.904929998876314959753358 ; -0.899629147103536800144342 ; -0.894192283720836729335637 ; -0.888620230707484040924981 ;

 -0.882913830481574073645470 ; -0.877073945772665439532627 ; -0.871101459491346550796200 ; -0.864997274595751144137121 ; -0.858762313955042966785823 ;

 -0.852397520209890250084237 ; -0.845903855629951054143931 ; -0.839282301968391021084600 ; -0.832533860313455524647230 ; -0.825659550937118650611534 ;

 -0.818660413140831885432406 ; -0.811537505098395829833580 ; -0.804291903695978689734633 ; -0.796924704369305728807154 ; -0.789437020938044295117764 ;

 -0.781829985437409458675147 ; -0.774104747947015717207115 ; -0.766262476417000644100858 ; -0.758304356491446765092016 ; -0.750231591329128358931528 ;

 -0.742045401421610281838045 ; -0.733747024408726316001889 ; -0.725337714891464938687812 ; -0.716818744242290800531501 ; -0.708191400412930589382399 ;

 -0.699456987739652339456557 ; -0.690616826746067624571761 ; -0.681672253943486448787259 ; -0.672624621628855017806731 ; -0.663475297680306939970658 ;

 -0.654225665350358766508700 ; -0.644877123056781136890077 ; -0.635431084171177146547142 ; -0.625888976805299900901619 ; -0.616252243595141561442344 ;

 -0.606522341482826526536576 ; -0.596700741496341721653202 ; -0.586788928527137300685706 ; -0.576788401105631382036211 ; -0.566700671174652760010815 ;

 -0.556527263860855843833077 ; -0.546269717244142383159817 ; -0.535929582125124840335150 ; -0.525508421790666565699453 ; -0.515007811777534223035005 ;

 -0.504429339634198197635551 ; -0.493774604680816999489812 ; -0.483045217767441948626854 ; -0.472242801030478698742627 ; -0.461368987647442418771401 ;

 -0.450425421590043710043279 ; -0.439413757375642589040685 ; -0.428335659817108112494341 ; -0.417192803771121462605751 ; -0.405986873884960545511889 ;

 -0.394719564341804385683361 ; -0.383392578604595822734854 ; -0.372007629158501235092510 ; -0.360566437252006227074021 ; -0.349070732636686422161576 ;

 -0.337522253305692705554261 ; -0.325922745230990453444769 ; -0.314273962099392474845918 ; -0.302577665047425574167140 ; -0.290835622395070819082047 ;

 -0.279049609378417768508970 ; -0.267221407881273079721012 ; -0.255352806165764071686080 ; -0.243445598601977973686482 ; -0.231501585396677734059116 ;

 -0.219522572321135403508985 ; -0.207510370438124240859625 ; -0.195466795828110816293869 ; -0.183393669314688508087976 ; -0.171292816189293903533225 ;

 -0.159166065935247723154292 ; -0.147015251951161989456661 ; -0.134842211273755257250625 ; -0.122648784300117812092492 ; -0.110436814509468826540991 ;

 -0.098208148184447540736015 ; -0.085964634131980604256000 ; -0.073708123403767780288977 ; -0.061440469016428270850728 ; -0.049163525671349973093019 ;

 -0.036879149474284021657652 ; -0.024589197654727010541405 ; -0.012295528285133320036860 ; 0.0 ; 0.012295528285133320036860 ; 0.024589197654727010541405 ;

 0.036879149474284021657652 ; 0.049163525671349973093019 ; 0.061440469016428270850728 ; 0.073708123403767780288977 ; 0.085964634131980604256000 ;

 0.098208148184447540736015 ; 0.110436814509468826540991 ; 0.122648784300117812092492 ; 0.134842211273755257250625 ; 0.147015251951161989456661 ;

 0.159166065935247723154292 ; 0.171292816189293903533225 ; 0.183393669314688508087976 ; 0.195466795828110816293869 ; 0.207510370438124240859625 ;

 0.219522572321135403508985 ; 0.231501585396677734059116 ; 0.243445598601977973686482 ; 0.255352806165764071686080 ; 0.267221407881273079721012 ;

 0.279049609378417768508970 ; 0.290835622395070819082047 ; 0.302577665047425574167140 ; 0.314273962099392474845918 ; 0.325922745230990453444769 ;

 0.337522253305692705554261 ; 0.349070732636686422161576 ; 0.360566437252006227074021 ; 0.372007629158501235092510 ; 0.383392578604595822734854 ;

 0.394719564341804385683361 ; 0.405986873884960545511889 ; 0.417192803771121462605751 ; 0.428335659817108112494341 ; 0.439413757375642589040685 ;

 0.450425421590043710043279 ; 0.461368987647442418771401 ; 0.472242801030478698742627 ; 0.483045217767441948626854 ; 0.493774604680816999489812 ;

 0.504429339634198197635551 ; 0.515007811777534223035005 ; 0.525508421790666565699453 ; 0.535929582125124840335150 ; 0.546269717244142383159817 ;

 0.556527263860855843833077 ; 0.566700671174652760010815 ; 0.576788401105631382036211 ; 0.586788928527137300685706 ; 0.596700741496341721653202 ;

 0.606522341482826526536576 ; 0.616252243595141561442344 ; 0.625888976805299900901619 ; 0.635431084171177146547142 ; 0.644877123056781136890077 ;

 0.654225665350358766508700 ; 0.663475297680306939970658 ; 0.672624621628855017806731 ; 0.681672253943486448787259 ; 0.690616826746067624571761 ;

 0.699456987739652339456557 ; 0.708191400412930589382399 ; 0.716818744242290800531501 ; 0.725337714891464938687812 ; 0.733747024408726316001889 ;

 0.742045401421610281838045 ; 0.750231591329128358931528 ; 0.758304356491446765092016 ; 0.766262476417000644100858 ; 0.774104747947015717207115 ;

 0.781829985437409458675147 ; 0.789437020938044295117764 ; 0.796924704369305728807154 ; 0.804291903695978689734633 ; 0.811537505098395829833580 ;

 0.818660413140831885432406 ; 0.825659550937118650611534 ; 0.832533860313455524647230 ; 0.839282301968391021084600 ; 0.845903855629951054143931 ;

 0.852397520209890250084237 ; 0.858762313955042966785823 ; 0.864997274595751144137121 ; 0.871101459491346550796200 ; 0.877073945772665439532627 ;

 0.882913830481574073645470 ; 0.888620230707484040924981 ; 0.894192283720836729335637 ; 0.899629147103536800144342 ; 0.904929998876314959753358 ;

 0.910094037623000801254172 ; 0.915120482611686961035103 ; 0.920008573912766315142721 ; 0.924757572513824425220425 ; 0.929366760431369935739045 ;

 0.933835440819386124349338 ; 0.938162938074687317626793 ; 0.942348597939064408301480 ; 0.946391787598204251752103 ; 0.950291895777368285733522 ;

 0.954048332833816317950921 ; 0.957660530845962076295490 ; 0.961127943699247839572910 ; 0.964450047168726298761719 ; 0.967626338998338798105523 ;

 0.970656338976880365477697 ; 0.973539589010643617645393 ; 0.976275653192735980815246 ; 0.978864117869068155239121 ; 0.981304591701017185126565 ;

 0.983596705724776358640192 ; 0.985740113407419277752900 ; 0.987734490699732356281248 ; 0.989579536085920123498574 ; 0.991274970630385567164523 ;

 0.992820538021989138984811 ; 0.994216004616630164799381 ; 0.995461159480026294089975 ; 0.996555814435198617028738 ; 0.997499804126615814044844 ;

 0.998292986136967889228248 ; 0.998935241284654635142155 ; 0.999426474680169959344386 ; 0.999766621312000569367063 ; 0.999955705317563751730191 |] ;;



let gauss_legendre_255_w = [| 0.00011367361999142272115645954414 ; 0.00026459387119083065532790838855 ; 0.00041569762526823913616284210066 ; 0.00056675794564824918946626058353 ;

 0.00071773647800611087798371518325 ; 0.00086860766611945667949717690640 ; 0.00101934797642732530281229369360 ; 0.0011699343729388079886897709773 ; 0.0013203439900221692090523602144 ;

 0.0014705540427783843160097204304 ; 0.0016205417990415653896921100325 ; 0.0017702845706603213070421243905 ; 0.0019197597117132050055085980675 ; 0.0020689446195015801533643667413 ;

 0.0022178167367540171700373764020 ; 0.0023663535543962867157201855305 ; 0.0025145326145997073931298921370 ; 0.0026623315139717112732749157331 ; 0.0028097279068204407457332299361 ;

 0.0029566995084575002760043344138 ; 0.0031032240985191112621977893133 ; 0.0032492795242943133198690930777 ; 0.0033948437040533928255056951665 ; 0.0035398946303722552150296713510 ;

 0.0036844103734499176530742235517 ; 0.0038283690844171626400743524999 ; 0.0039717489986349171988699773906 ; 0.0041145284389812475901826468094 ; 0.0042566858191260658425395494472 ;

 0.0043981996467927779838546384780 ; 0.0045390485270061921259394035112 ; 0.0046792111653260640506279893190 ; 0.0048186663710656988918572043815 ; 0.0049573930604950563104281084148 ;

 0.0050953702600278273039420404117 ; 0.0052325771093919661294970523234 ; 0.0053689928647831724787741258653 ; 0.0055045969020008281904902120813 ; 0.0056393687195659001929970994675 ;

 0.0057732879418203275712033691864 ; 0.0059063343220074160130475409466 ; 0.0060384877453327676663371666884 ; 0.0061697282320052788060812561217 ; 0.0063000359402577418025981070425 ;

 0.0064293911693465917826140832500 ; 0.0065577743625303421548456356354 ; 0.0066851661100262568757892743568 ; 0.0068115471519448109954345674817 ; 0.0069368983812014946719507501243 ;

 0.0070612008464055194979848418291 ; 0.0071844357547249896530757997058 ; 0.0073065844747281040972736443146 ; 0.0074276285391999597581348419714 ; 0.0075475496479345294426435656724 ;

 0.0076663296705013920315933272426 ; 0.0077839506489867963897419914623 ; 0.0079003948007086443529587296692 ; 0.0080156445209049821352946484008 ; 0.0081296823853955935356080649925 ;

 0.0082424911532162924158504385939 ; 0.0083540537692255160718568405530 ; 0.0084643533666828253227353760036 ; 0.0085733732697989214067758505840 ; 0.0086810969962567940901133439612 ;

 0.0087875082597036197689825483144 ; 0.0088925909722130327769834298578 ; 0.0089963292467173975949700110383 ; 0.0090987073994097142025303711406 ; 0.0091997099521147934060534414075 ;

 0.0092993216346293436285393234867 ; 0.0093975273870306153500305317074 ; 0.0094943123619532541442165010292 ; 0.0095896619268340180657610209655 ; 0.0096835616661240200035669970076 ;

 0.0097759973834681605268499842249 ; 0.0098669551038514217128483481814 ; 0.0099564210757116974565448593910 ; 0.0100443817730188408231888789497 ; 0.0101308238973196141129538950955 ;

 0.0102157343797482324629939488415 ; 0.0102991003830021970147153502911 ; 0.0103809093032831189224876935085 ; 0.0104611487722022407735015844669 ; 0.0105398066586503673262517188088 ;

 0.0106168710706319228563864391054 ; 0.0106923303570628578226139809571 ; 0.0107661731095321330311788312990 ; 0.0108383881640265149842990798832 ; 0.0109089646026184216450603134401 ;

 0.0109778917551165634377595759712 ; 0.0110451592006791299277436662993 ; 0.0111107567693892782875426356195 ; 0.0111746745437926853557086684962 ; 0.0112369028603969308303734810332 ;

 0.0112974323111324849102690558722 ; 0.0113562537447750795009464486204 ; 0.011413358268329247942299599697 ; 0.011468737248372824084374355981 ; 0.011522382312362197440930930031 ;

 0.011574285349898127083439539046 ; 0.011624438513951922901227922331 ; 0.011672834222051808845465154244 ; 0.011719465157429288794653489478 ; 0.011764324270125341726399410909 ;

 0.011807404778056278953532930501 ; 0.011848700168039102281222824051 ; 0.011888204196776208064673282076 ; 0.011925910891799288293359117699 ; 0.011961814552372285996633285380 ;

 0.011995909750353268455989686823 ; 0.012028191331015087920350431142 ; 0.012058654413824705751531083631 ; 0.012087294393181062176578184854 ; 0.012114106939111380091025793650 ;

 0.012139087997925797641334635250 ; 0.012162233792830230614908682534 ; 0.012183540824497371981177306326 ; 0.012203005871595742256331865516 ; 0.012220625991276710706457005806 ;

 0.012236398519619413758040249691 ; 0.012250321072033503350218104906 ; 0.012262391543619664338660618398 ; 0.012272608109487846445745237751 ; 0.012280969225033162644659793962 ;

 0.012287473626169412265336919908 ; 0.012292120329520193516690694701 ; 0.012294908632567576531532225710 ; 0.01229583811375831445681490730 ; 0.012294908632567576531532225710 ;

 0.012292120329520193516690694701 ; 0.012287473626169412265336919908 ; 0.012280969225033162644659793962 ; 0.012272608109487846445745237751 ; 0.012262391543619664338660618398 ;

 0.012250321072033503350218104906 ; 0.012236398519619413758040249691 ; 0.012220625991276710706457005806 ; 0.012203005871595742256331865516 ; 0.012183540824497371981177306326 ;

 0.012162233792830230614908682534 ; 0.012139087997925797641334635250 ; 0.012114106939111380091025793650 ; 0.012087294393181062176578184854 ; 0.012058654413824705751531083631 ;

 0.012028191331015087920350431142 ; 0.011995909750353268455989686823 ; 0.011961814552372285996633285380 ; 0.011925910891799288293359117699 ; 0.011888204196776208064673282076 ;

 0.011848700168039102281222824051 ; 0.011807404778056278953532930501 ; 0.011764324270125341726399410909 ; 0.011719465157429288794653489478 ; 0.011672834222051808845465154244 ;

 0.011624438513951922901227922331 ; 0.011574285349898127083439539046 ; 0.011522382312362197440930930031 ; 0.011468737248372824084374355981 ; 0.011413358268329247942299599697 ;

 0.0113562537447750795009464486204 ; 0.0112974323111324849102690558722 ; 0.0112369028603969308303734810332 ; 0.0111746745437926853557086684962 ; 0.0111107567693892782875426356195 ;

 0.0110451592006791299277436662993 ; 0.0109778917551165634377595759712 ; 0.0109089646026184216450603134401 ; 0.0108383881640265149842990798832 ; 0.0107661731095321330311788312990 ;

 0.0106923303570628578226139809571 ; 0.0106168710706319228563864391054 ; 0.0105398066586503673262517188088 ; 0.0104611487722022407735015844669 ; 0.0103809093032831189224876935085 ;

 0.0102991003830021970147153502911 ; 0.0102157343797482324629939488415 ; 0.0101308238973196141129538950955 ; 0.0100443817730188408231888789497 ; 0.0099564210757116974565448593910 ;

 0.0098669551038514217128483481814 ; 0.0097759973834681605268499842249 ; 0.0096835616661240200035669970076 ; 0.0095896619268340180657610209655 ; 0.0094943123619532541442165010292 ;

 0.0093975273870306153500305317074 ; 0.0092993216346293436285393234867 ; 0.0091997099521147934060534414075 ; 0.0090987073994097142025303711406 ; 0.0089963292467173975949700110383 ;

 0.0088925909722130327769834298578 ; 0.0087875082597036197689825483144 ; 0.0086810969962567940901133439612 ; 0.0085733732697989214067758505840 ; 0.0084643533666828253227353760036 ;

 0.0083540537692255160718568405530 ; 0.0082424911532162924158504385939 ; 0.0081296823853955935356080649925 ; 0.0080156445209049821352946484008 ; 0.0079003948007086443529587296692 ;

 0.0077839506489867963897419914623 ; 0.0076663296705013920315933272426 ; 0.0075475496479345294426435656724 ; 0.0074276285391999597581348419714 ; 0.0073065844747281040972736443146 ;

 0.0071844357547249896530757997058 ; 0.0070612008464055194979848418291 ; 0.0069368983812014946719507501243 ; 0.0068115471519448109954345674817 ; 0.0066851661100262568757892743568 ;

 0.0065577743625303421548456356354 ; 0.0064293911693465917826140832500 ; 0.0063000359402577418025981070425 ; 0.0061697282320052788060812561217 ; 0.0060384877453327676663371666884 ;

 0.0059063343220074160130475409466 ; 0.0057732879418203275712033691864 ; 0.0056393687195659001929970994675 ; 0.0055045969020008281904902120813 ; 0.0053689928647831724787741258653 ;

 0.0052325771093919661294970523234 ; 0.0050953702600278273039420404117 ; 0.0049573930604950563104281084148 ; 0.0048186663710656988918572043815 ; 0.0046792111653260640506279893190 ;

 0.0045390485270061921259394035112 ; 0.0043981996467927779838546384780 ; 0.0042566858191260658425395494472 ; 0.0041145284389812475901826468094 ; 0.0039717489986349171988699773906 ;

 0.0038283690844171626400743524999 ; 0.0036844103734499176530742235517 ; 0.0035398946303722552150296713510 ; 0.0033948437040533928255056951665 ; 0.0032492795242943133198690930777 ;

 0.0031032240985191112621977893133 ; 0.0029566995084575002760043344138 ; 0.0028097279068204407457332299361 ; 0.0026623315139717112732749157331 ; 0.0025145326145997073931298921370 ;

 0.0023663535543962867157201855305 ; 0.0022178167367540171700373764020 ; 0.0020689446195015801533643667413 ; 0.0019197597117132050055085980675 ; 0.0017702845706603213070421243905 ;

 0.0016205417990415653896921100325 ; 0.0014705540427783843160097204304 ; 0.0013203439900221692090523602144 ; 0.0011699343729388079886897709773 ; 0.00101934797642732530281229369360 ;

 0.00086860766611945667949717690640 ; 0.00071773647800611087798371518325 ; 0.00056675794564824918946626058353 ; 0.00041569762526823913616284210066 ; 0.00026459387119083065532790838855 ;

 0.00011367361999142272115645954414 |] ;;





let gauss_legendre_256_x = [| -0.999956050018992230734801 ; -0.999768437409263186104879 ; -0.999430937466261408240854 ; -0.998943525843408856555026 ;

 -0.998306266473006444055500 ; -0.997519252756720827563409 ; -0.996582602023381540430504 ; -0.995496454481096356592647 ; -0.994260972922409664962878 ;

 -0.992876342608822117143534 ; -0.991342771207583086922189 ; -0.989660488745065218319244 ; -0.987829747564860608916488 ; -0.985850822286125956479245 ;

 -0.983724009760315496166686 ; -0.981449629025464405769303 ; -0.979028021257622038824238 ; -0.976459549719234155621011 ; -0.973744599704370405266079 ;

 -0.970883578480743029320923 ; -0.967876915228489454909004 ; -0.964725060975706430932612 ; -0.961428488530732144006407 ; -0.957987692411178129365790 ;

 -0.954403188769716241764448 ; -0.950675515316628276363852 ; -0.946805231239127481372052 ; -0.942792917117462443183076 ; -0.938639174837814804981926 ;

 -0.934344627502003094292477 ; -0.929909919334005641180246 ; -0.925335715583316202872730 ; -0.920622702425146495505047 ; -0.915771586857490384526670 ;

 -0.910783096595065011890907 ; -0.905657979960144647082682 ; -0.900397005770303544771620 ; -0.895000963223084577441223 ; -0.889470661777610888828677 ;

 -0.883806931033158284859826 ; -0.878010620604706543986435 ; -0.872082599995488289130046 ; -0.866023758466554519297515 ; -0.859835004903376350696173 ;

 -0.853517267679502965073036 ; -0.847071494517296207187072 ; -0.840498652345762713895068 ; -0.833799727155504894348444 ; -0.826975723850812514289093 ;

 -0.820027666098917067403478 ; -0.812956596176431543136410 ; -0.805763574812998623257389 ; -0.798449681032170758782543 ; -0.791016011989545994546707 ;

 -0.783463682808183820750670 ; -0.775793826411325739132053 ; -0.768007593352445635975891 ; -0.760106151642655454941907 ; -0.752090686575492059587530 ;

 -0.743962400549111568455683 ; -0.735722512885917834620373 ; -0.727372259649652126586894 ; -0.718912893459971448372640 ; -0.710345683304543313394566 ;

 -0.701671914348685159406084 ; -0.692892887742576960105342 ; -0.684009920426075953124877 ; -0.675024344931162763855919 ; -0.665937509182048559906408 ;

 -0.656750776292973221887500 ; -0.647465524363724862617016 ; -0.638083146272911368668689 ; -0.628605049469014975432210 ; -0.619032655759261219430968 ;

 -0.609367401096333939522311 ; -0.599610735362968321730388 ; -0.589764122154454300785786 ; -0.579829038559082944921832 ; -0.569806974936568759057668 ;

 -0.559699434694481145136907 ; -0.549507934062718557042427 ; -0.539234001866059181127936 ; -0.528879179294822261951476 ; -0.518445019673674476221662 ;

 -0.507933088228616036231925 ; -0.497344961852181477119512 ; -0.486682228866890350103621 ; -0.475946488786983306390738 ; -0.465139352078479313645570 ;

 -0.454262439917589998774455 ; -0.443317383947527357216926 ; -0.432305826033741309953441 ; -0.421229418017623824976812 ; -0.410089821468716550006434 ;

 -0.398888707435459127713463 ; -0.387627756194515583637985 ; -0.376308656998716390283056 ; -0.364933107823654018533465 ; -0.353502815112969989537790 ;

 -0.342019493522371636480730 ; -0.330484865662416976229187 ; -0.318900661840106275631683 ; -0.307268619799319076258610 ; -0.295590484460135614563787 ;

 -0.283868007657081741799766 ; -0.272102947876336609505245 ; -0.260297069991942541978561 ; -0.248452145001056666833243 ; -0.236569949758284018477508 ;

 -0.224652266709131967147878 ; -0.212700883622625957937040 ; -0.200717593323126670068001 ; -0.188704193421388826461504 ; -0.176662486044901997403722 ;

 -0.164594277567553849829285 ; -0.152501378338656395374607 ; -0.140385602411375885913025 ; -0.128248767270607094742050 ; -0.116092693560332804940735 ;

 -0.103919204810509403639197 ; -0.091730127163519552031146 ; -0.079527289100232965903227 ; -0.067312521165716400242290 ; -0.055087655694633984104561 ;

 -0.042854526536379098381242 ; -0.030614968779979029366279 ; -0.018370818478813665117926 ; -0.006123912375189529501170 ; 0.006123912375189529501170 ;

 0.018370818478813665117926 ; 0.030614968779979029366279 ; 0.042854526536379098381242 ; 0.055087655694633984104561 ; 0.067312521165716400242290 ;

 0.079527289100232965903227 ; 0.091730127163519552031146 ; 0.103919204810509403639197 ; 0.116092693560332804940735 ; 0.128248767270607094742050 ;

 0.140385602411375885913025 ; 0.152501378338656395374607 ; 0.164594277567553849829285 ; 0.176662486044901997403722 ; 0.188704193421388826461504 ;

 0.200717593323126670068001 ; 0.212700883622625957937040 ; 0.224652266709131967147878 ; 0.236569949758284018477508 ; 0.248452145001056666833243 ;

 0.260297069991942541978561 ; 0.272102947876336609505245 ; 0.283868007657081741799766 ; 0.295590484460135614563787 ; 0.307268619799319076258610 ;

 0.318900661840106275631683 ; 0.330484865662416976229187 ; 0.342019493522371636480730 ; 0.353502815112969989537790 ; 0.364933107823654018533465 ;

 0.376308656998716390283056 ; 0.387627756194515583637985 ; 0.398888707435459127713463 ; 0.410089821468716550006434 ; 0.421229418017623824976812 ;

 0.432305826033741309953441 ; 0.443317383947527357216926 ; 0.454262439917589998774455 ; 0.465139352078479313645570 ; 0.475946488786983306390738 ;

 0.486682228866890350103621 ; 0.497344961852181477119512 ; 0.507933088228616036231925 ; 0.518445019673674476221662 ; 0.528879179294822261951476 ;

 0.539234001866059181127936 ; 0.549507934062718557042427 ; 0.559699434694481145136907 ; 0.569806974936568759057668 ; 0.579829038559082944921832 ;

 0.589764122154454300785786 ; 0.599610735362968321730388 ; 0.609367401096333939522311 ; 0.619032655759261219430968 ; 0.628605049469014975432210 ;

 0.638083146272911368668689 ; 0.647465524363724862617016 ; 0.656750776292973221887500 ; 0.665937509182048559906408 ; 0.675024344931162763855919 ;

 0.684009920426075953124877 ; 0.692892887742576960105342 ; 0.701671914348685159406084 ; 0.710345683304543313394566 ; 0.718912893459971448372640 ;

 0.727372259649652126586894 ; 0.735722512885917834620373 ; 0.743962400549111568455683 ; 0.752090686575492059587530 ; 0.760106151642655454941907 ;

 0.768007593352445635975891 ; 0.775793826411325739132053 ; 0.783463682808183820750670 ; 0.791016011989545994546707 ; 0.798449681032170758782543 ;

 0.805763574812998623257389 ; 0.812956596176431543136410 ; 0.820027666098917067403478 ; 0.826975723850812514289093 ; 0.833799727155504894348444 ;

 0.840498652345762713895068 ; 0.847071494517296207187072 ; 0.853517267679502965073036 ; 0.859835004903376350696173 ; 0.866023758466554519297515 ;

 0.872082599995488289130046 ; 0.878010620604706543986435 ; 0.883806931033158284859826 ; 0.889470661777610888828677 ; 0.895000963223084577441223 ;

 0.900397005770303544771620 ; 0.905657979960144647082682 ; 0.910783096595065011890907 ; 0.915771586857490384526670 ; 0.920622702425146495505047 ;

 0.925335715583316202872730 ; 0.929909919334005641180246 ; 0.934344627502003094292477 ; 0.938639174837814804981926 ; 0.942792917117462443183076 ;

 0.946805231239127481372052 ; 0.950675515316628276363852 ; 0.954403188769716241764448 ; 0.957987692411178129365790 ; 0.961428488530732144006407 ;

 0.964725060975706430932612 ; 0.967876915228489454909004 ; 0.970883578480743029320923 ; 0.973744599704370405266079 ; 0.976459549719234155621011 ;

 0.979028021257622038824238 ; 0.981449629025464405769303 ; 0.983724009760315496166686 ; 0.985850822286125956479245 ; 0.987829747564860608916488 ;

 0.989660488745065218319244 ; 0.991342771207583086922189 ; 0.992876342608822117143534 ; 0.994260972922409664962878 ; 0.995496454481096356592647 ;

 0.996582602023381540430504 ; 0.997519252756720827563409 ; 0.998306266473006444055500 ; 0.998943525843408856555026 ; 0.999430937466261408240854 ;

 0.999768437409263186104879 ; 0.999956050018992230734801 |] ;;



let gauss_legendre_256_w = [| 0.00011278901782227217551253887725 ; 0.00026253494429644590628745756250 ; 0.00041246325442617632843218583774 ; 0.00056234895403140980281523674759 ;

 0.0007121541634733206669089891511 ; 0.0008618537014200890378140934163 ; 0.0010114243932084404526058128414 ; 0.0011608435575677247239705981135 ; 0.0013100886819025044578316804271 ;

 0.0014591373333107332010883864996 ; 0.0016079671307493272424499395690 ; 0.0017565557363307299936069145295 ; 0.0019048808534997184044191411746 ; 0.0020529202279661431745487818492 ;

 0.0022006516498399104996848834189 ; 0.0023480529563273120170064609087 ; 0.0024951020347037068508395354372 ; 0.0026417768254274905641208292516 ; 0.0027880553253277068805747610763 ;

 0.0029339155908297166460123254142 ; 0.0030793357411993375832053528316 ; 0.0032242939617941981570107134269 ; 0.0033687685073155510120191062489 ; 0.0035127377050563073309710549844 ;

 0.0036561799581425021693892413052 ; 0.0037990737487662579981170192082 ; 0.0039413976414088336277290349840 ; 0.0040831302860526684085997759212 ; 0.0042242504213815362723565049060 ;

 0.0043647368779680566815684200621 ; 0.0045045685814478970686417923159 ; 0.0046437245556800603139790923525 ; 0.0047821839258926913729317340448 ; 0.0049199259218138656695587765655 ;

 0.0050569298807868423875578160762 ; 0.0051931752508692809303287536296 ; 0.0053286415939159303170811114788 ; 0.0054633085886443102775705318566 ; 0.0055971560336829100775514452572 ;

 0.005730163850601437177384417555 ; 0.005862312086922653060661598801 ; 0.005993580919115338221127696870 ; 0.006123950655567932542389081187 ; 0.006253401739542401272063645975 ;

 0.006381914752107880570375164275 ; 0.006509470415053660267809899951 ; 0.006636049593781065044590038355 ; 0.006761633300173798780927861108 ; 0.006886202695446320346713323775 ;

 0.007009739092969822621234436194 ; 0.007132223961075390071672422986 ; 0.007253638925833913783829137214 ; 0.007373965773812346437572440695 ; 0.007493186454805883358599761133 ;

 0.007611283084545659461618719618 ; 0.007728237947381555631110194958 ; 0.007844033498939711866810316151 ; 0.007958652368754348353613161227 ; 0.008072077362873499500946974804 ;

 0.008184291466438269935619761004 ; 0.008295277846235225425171412553 ; 0.008405019853221535756180301698 ; 0.008513501025022490693838354790 ; 0.008620705088401014305368838410 ;

 0.008726615961698807140336632217 ; 0.008831217757248750025318272685 ; 0.008934494783758207548408417085 ; 0.009036431548662873680227775572 ; 0.009137012760450806402000472219 ;

 0.009236223330956302687378716714 ; 0.009334048377623269712466014486 ; 0.009430473225737752747352764482 ; 0.009525483410629284811829685754 ; 0.009619064679840727857162164401 ;

 0.009711202995266279964249670496 ; 0.009801884535257327825498800250 ; 0.009891095696695828602630683809 ; 0.009978823097034910124733949495 ; 0.010065053576306383309460978930 ;

 0.010149774199094865654634066042 ; 0.010232972256478219656954857160 ; 0.010314635267934015068260713997 ; 0.010394750983211728997101725205 ; 0.010473307384170403003569566927 ;

 0.010550292686581481517533575536 ; 0.010625695341896561133961681801 ; 0.010699504038979785603048200583 ; 0.010771707705804626636653631927 ; 0.010842295511114795995293477058 ;

 0.010911256866049039700796847788 ; 0.010978581425729570637988203448 ; 0.011044259090813901263517571044 ; 0.011108280009009843630460815451 ; 0.011170634576553449462710881938 ;

 0.011231313439649668572656802083 ; 0.011290307495875509508367594121 ; 0.011347607895545491941625714297 ; 0.011403206043039185964847059552 ; 0.011457093598090639152334392298 ;

 0.011509262477039497958586392439 ; 0.011559704854043635772668656950 ; 0.011608413162253105722084706677 ; 0.011655380094945242121298939730 ; 0.011700598606620740288189823359 ;

 0.011744061914060550305376732759 ; 0.011785763497343426181690117627 ; 0.011825697100823977771160737958 ; 0.011863856734071078731904572908 ; 0.011900236672766489754287204237 ;

 0.011934831459563562255873201696 ; 0.011967635904905893729007282670 ; 0.011998645087805811934536710071 ; 0.012027854356582571161267533498 ; 0.012055259329560149814347085327 ;

 0.012080855895724544655975183976 ; 0.012104640215340463097757829736 ; 0.012126608720527321034718492205 ; 0.012146758115794459815559837664 ; 0.012165085378535502061307291839 ;

 0.012181587759481772174047585032 ; 0.012196262783114713518180974196 ; 0.012209108248037240407514094371 ; 0.012220122227303969191708737227 ; 0.012229303068710278904146266083 ;

 0.012236649395040158109242574767 ; 0.012242160104272800769728083260 ; 0.012245834369747920142463857550 ; 0.01224767164028975590407032649 ; 0.01224767164028975590407032649 ;

 0.012245834369747920142463857550 ; 0.012242160104272800769728083260 ; 0.012236649395040158109242574767 ; 0.012229303068710278904146266083 ; 0.012220122227303969191708737227 ;

 0.012209108248037240407514094371 ; 0.012196262783114713518180974196 ; 0.012181587759481772174047585032 ; 0.012165085378535502061307291839 ; 0.012146758115794459815559837664 ;

 0.012126608720527321034718492205 ; 0.012104640215340463097757829736 ; 0.012080855895724544655975183976 ; 0.012055259329560149814347085327 ; 0.012027854356582571161267533498 ;

 0.011998645087805811934536710071 ; 0.011967635904905893729007282670 ; 0.011934831459563562255873201696 ; 0.011900236672766489754287204237 ; 0.011863856734071078731904572908 ;

 0.011825697100823977771160737958 ; 0.011785763497343426181690117627 ; 0.011744061914060550305376732759 ; 0.011700598606620740288189823359 ; 0.011655380094945242121298939730 ;

 0.011608413162253105722084706677 ; 0.011559704854043635772668656950 ; 0.011509262477039497958586392439 ; 0.011457093598090639152334392298 ; 0.011403206043039185964847059552 ;

 0.011347607895545491941625714297 ; 0.011290307495875509508367594121 ; 0.011231313439649668572656802083 ; 0.011170634576553449462710881938 ; 0.011108280009009843630460815451 ;

 0.011044259090813901263517571044 ; 0.010978581425729570637988203448 ; 0.010911256866049039700796847788 ; 0.010842295511114795995293477058 ; 0.010771707705804626636653631927 ;

 0.010699504038979785603048200583 ; 0.010625695341896561133961681801 ; 0.010550292686581481517533575536 ; 0.010473307384170403003569566927 ; 0.010394750983211728997101725205 ;

 0.010314635267934015068260713997 ; 0.010232972256478219656954857160 ; 0.010149774199094865654634066042 ; 0.010065053576306383309460978930 ; 0.009978823097034910124733949495 ;

 0.009891095696695828602630683809 ; 0.009801884535257327825498800250 ; 0.009711202995266279964249670496 ; 0.009619064679840727857162164401 ; 0.009525483410629284811829685754 ;

 0.009430473225737752747352764482 ; 0.009334048377623269712466014486 ; 0.009236223330956302687378716714 ; 0.009137012760450806402000472219 ; 0.009036431548662873680227775572 ;

 0.008934494783758207548408417085 ; 0.008831217757248750025318272685 ; 0.008726615961698807140336632217 ; 0.008620705088401014305368838410 ; 0.008513501025022490693838354790 ;

 0.008405019853221535756180301698 ; 0.008295277846235225425171412553 ; 0.008184291466438269935619761004 ; 0.008072077362873499500946974804 ; 0.007958652368754348353613161227 ;

 0.007844033498939711866810316151 ; 0.007728237947381555631110194958 ; 0.007611283084545659461618719618 ; 0.007493186454805883358599761133 ; 0.007373965773812346437572440695 ;

 0.007253638925833913783829137214 ; 0.007132223961075390071672422986 ; 0.007009739092969822621234436194 ; 0.006886202695446320346713323775 ; 0.006761633300173798780927861108 ;

 0.006636049593781065044590038355 ; 0.006509470415053660267809899951 ; 0.006381914752107880570375164275 ; 0.006253401739542401272063645975 ; 0.006123950655567932542389081187 ;

 0.005993580919115338221127696870 ; 0.005862312086922653060661598801 ; 0.005730163850601437177384417555 ; 0.0055971560336829100775514452572 ; 0.0054633085886443102775705318566 ;

 0.0053286415939159303170811114788 ; 0.0051931752508692809303287536296 ; 0.0050569298807868423875578160762 ; 0.0049199259218138656695587765655 ; 0.0047821839258926913729317340448 ;

 0.0046437245556800603139790923525 ; 0.0045045685814478970686417923159 ; 0.0043647368779680566815684200621 ; 0.0042242504213815362723565049060 ; 0.0040831302860526684085997759212 ;

 0.0039413976414088336277290349840 ; 0.0037990737487662579981170192082 ; 0.0036561799581425021693892413052 ; 0.0035127377050563073309710549844 ; 0.0033687685073155510120191062489 ;

 0.0032242939617941981570107134269 ; 0.0030793357411993375832053528316 ; 0.0029339155908297166460123254142 ; 0.0027880553253277068805747610763 ; 0.0026417768254274905641208292516 ;

 0.0024951020347037068508395354372 ; 0.0023480529563273120170064609087 ; 0.0022006516498399104996848834189 ; 0.0020529202279661431745487818492 ; 0.0019048808534997184044191411746 ;

 0.0017565557363307299936069145295 ; 0.0016079671307493272424499395690 ; 0.0014591373333107332010883864996 ; 0.0013100886819025044578316804271 ; 0.0011608435575677247239705981135 ;

 0.0010114243932084404526058128414 ; 0.0008618537014200890378140934163 ; 0.0007121541634733206669089891511 ; 0.00056234895403140980281523674759 ; 0.00041246325442617632843218583774 ;

 0.00026253494429644590628745756250 ; 0.00011278901782227217551253887725 |] ;;





let gauss_legendre_257_x = [| -0.999956390712330402472857 ; -0.999770232390338019056053 ; -0.999435348366365078441838 ; -0.998951714093223210129834 ;

 -0.998319392445383847808766 ; -0.997538475365520218731818 ; -0.996609078365487004512326 ; -0.995531339486830143483750 ; -0.994305419008553630362377 ;

 -0.992931499332908653172844 ; -0.991409784923101705201254 ; -0.989740502257507526030375 ; -0.987923899788618253106809 ; -0.985960247902290665366669 ;

 -0.983849838875444644048531 ; -0.981592986831381877693095 ; -0.979190027692327124191591 ; -0.976641319128992592610888 ; -0.973947240507062326750976 ;

 -0.971108192830542793021113 ; -0.968124598681952354372943 ; -0.964996902159337170373447 ; -0.961725568810109767190665 ; -0.958311085561711847074814 ;

 -0.954753960649106318830855 ; -0.951054723539105826691801 ; -0.947213924851546682950881 ; -0.943232136277318328151464 ; -0.939109950493259404355123 ;

 -0.934847981073932324370129 ; -0.930446862400288909805510 ; -0.925907249565240289235888 ; -0.921229818276144817520964 ; -0.916415264754228313295468 ;

 -0.911464305630951423630955 ; -0.906377677841339419411308 ; -0.901156138514290206476301 ; -0.895800464859876809085345 ; -0.890311454053661045810287 ;

 -0.884689923118035575018750 ; -0.878936708800611938658765 ; -0.873052667449672679799858 ; -0.867038674886706051812473 ; -0.860895626276042275514686 ;

 -0.854624435991610735314055 ; -0.848226037480837936478636 ; -0.841701383125706473284556 ; -0.835051444100995681967937 ; -0.828277210229725073186687 ;

 -0.821379689835822056081139 ; -0.814359909594035880004229 ; -0.807218914377120130552073 ; -0.799957767100306523636066 ; -0.792577548563093144962574 ;

 -0.785079357288370682385816 ; -0.777464309358910595129671 ; -0.769733538251239556788216 ; -0.761888194666924898264210 ; -0.753929446361296162339238 ;

 -0.745858477969628263337895 ; -0.737676490830812123299244 ; -0.729384702808539030149808 ; -0.720984348110025333531072 ; -0.712476677102304460118510 ;

 -0.703862956126113592426171 ; -0.695144467307402713168813 ; -0.686322508366494071200553 ; -0.677398392424920474813593 ; -0.668373447809971163711735 ;

 -0.659249017856974352220492 ; -0.650026460709345873208532 ; -0.640707149116433684724434 ; -0.631292470229188329449219 ; -0.621783825393689760680446 ;

 -0.612182629942561267650033 ; -0.602490312984301547488097 ; -0.592708317190566281032495 ; -0.582838098581430874902446 ; -0.572881126308666332759406 ;

 -0.562838882437060514424546 ; -0.552712861723817332466074 ; -0.542504571396066721967792 ; -0.532215530926518500400434 ; -0.521847271807293510797499 ;

 -0.511401337321965712746629 ; -0.500879282315849152005553 ; -0.490282672964564000798817 ; -0.479613086540916117008992 ; -0.468872111180124821505728 ;

 -0.458061345643433838720630 ; -0.447182399080140586238810 ; -0.436236890788079234603398 ; -0.425226449972593188682213 ; -0.414152715504032866791986 ;

 -0.403017335673814873281489 ; -0.391821967949078874408131 ; -0.380568278725978696070941 ; -0.369257943081644365255611 ; -0.357892644524852014873858 ;

 -0.346474074745438764010632 ; -0.335003933362499872399782 ; -0.323483927671405649204085 ; -0.311915772389675771851948 ; -0.300301189401748840754520 ;

 -0.288641907502685160168097 ; -0.276939662140840894253032 ; -0.265196195159551900488370 ; -0.253413254537865690008131 ; -0.241592594130360106108882 ;

 -0.229735973406087448117604 ; -0.217845157186682897983880 ; -0.205921915383676231351599 ; -0.193968022735045913454182 ; -0.181985258541054792946197 ;

 -0.169975406399406713716337 ; -0.157940253939763465806087 ; -0.145881592557661591770148 ; -0.133801217147868654144405 ; -0.121700925837218653121859 ;

 -0.109582519716966361063898 ; -0.097447802574700412082119 ; -0.085298580625855050603929 ; -0.073136662244860502573600 ; -0.060963857695971986730406 ;

 -0.048781978863817431238958 ; -0.036592838983704002816750 ; -0.024398252371723591403953 ; -0.012200034154697423345412 ; 0.0 ; 0.012200034154697423345412 ;

 0.024398252371723591403953 ; 0.036592838983704002816750 ; 0.048781978863817431238958 ; 0.060963857695971986730406 ; 0.073136662244860502573600 ;

 0.085298580625855050603929 ; 0.097447802574700412082119 ; 0.109582519716966361063898 ; 0.121700925837218653121859 ; 0.133801217147868654144405 ;

 0.145881592557661591770148 ; 0.157940253939763465806087 ; 0.169975406399406713716337 ; 0.181985258541054792946197 ; 0.193968022735045913454182 ;

 0.205921915383676231351599 ; 0.217845157186682897983880 ; 0.229735973406087448117604 ; 0.241592594130360106108882 ; 0.253413254537865690008131 ;

 0.265196195159551900488370 ; 0.276939662140840894253032 ; 0.288641907502685160168097 ; 0.300301189401748840754520 ; 0.311915772389675771851948 ;

 0.323483927671405649204085 ; 0.335003933362499872399782 ; 0.346474074745438764010632 ; 0.357892644524852014873858 ; 0.369257943081644365255611 ;

 0.380568278725978696070941 ; 0.391821967949078874408131 ; 0.403017335673814873281489 ; 0.414152715504032866791986 ; 0.425226449972593188682213 ;

 0.436236890788079234603398 ; 0.447182399080140586238810 ; 0.458061345643433838720630 ; 0.468872111180124821505728 ; 0.479613086540916117008992 ;

 0.490282672964564000798817 ; 0.500879282315849152005553 ; 0.511401337321965712746629 ; 0.521847271807293510797499 ; 0.532215530926518500400434 ;

 0.542504571396066721967792 ; 0.552712861723817332466074 ; 0.562838882437060514424546 ; 0.572881126308666332759406 ; 0.582838098581430874902446 ;

 0.592708317190566281032495 ; 0.602490312984301547488097 ; 0.612182629942561267650033 ; 0.621783825393689760680446 ; 0.631292470229188329449219 ;

 0.640707149116433684724434 ; 0.650026460709345873208532 ; 0.659249017856974352220492 ; 0.668373447809971163711735 ; 0.677398392424920474813593 ;

 0.686322508366494071200553 ; 0.695144467307402713168813 ; 0.703862956126113592426171 ; 0.712476677102304460118510 ; 0.720984348110025333531072 ;

 0.729384702808539030149808 ; 0.737676490830812123299244 ; 0.745858477969628263337895 ; 0.753929446361296162339238 ; 0.761888194666924898264210 ;

 0.769733538251239556788216 ; 0.777464309358910595129671 ; 0.785079357288370682385816 ; 0.792577548563093144962574 ; 0.799957767100306523636066 ;

 0.807218914377120130552073 ; 0.814359909594035880004229 ; 0.821379689835822056081139 ; 0.828277210229725073186687 ; 0.835051444100995681967937 ;

 0.841701383125706473284556 ; 0.848226037480837936478636 ; 0.854624435991610735314055 ; 0.860895626276042275514686 ; 0.867038674886706051812473 ;

 0.873052667449672679799858 ; 0.878936708800611938658765 ; 0.884689923118035575018750 ; 0.890311454053661045810287 ; 0.895800464859876809085345 ;

 0.901156138514290206476301 ; 0.906377677841339419411308 ; 0.911464305630951423630955 ; 0.916415264754228313295468 ; 0.921229818276144817520964 ;

 0.925907249565240289235888 ; 0.930446862400288909805510 ; 0.934847981073932324370129 ; 0.939109950493259404355123 ; 0.943232136277318328151464 ;

 0.947213924851546682950881 ; 0.951054723539105826691801 ; 0.954753960649106318830855 ; 0.958311085561711847074814 ; 0.961725568810109767190665 ;

 0.964996902159337170373447 ; 0.968124598681952354372943 ; 0.971108192830542793021113 ; 0.973947240507062326750976 ; 0.976641319128992592610888 ;

 0.979190027692327124191591 ; 0.981592986831381877693095 ; 0.983849838875444644048531 ; 0.985960247902290665366669 ; 0.987923899788618253106809 ;

 0.989740502257507526030375 ; 0.991409784923101705201254 ; 0.992931499332908653172844 ; 0.994305419008553630362377 ; 0.995531339486830143483750 ;

 0.996609078365487004512326 ; 0.997538475365520218731818 ; 0.998319392445383847808766 ; 0.998951714093223210129834 ; 0.999435348366365078441838 ;

 0.999770232390338019056053 ; 0.999956390712330402472857 |] ;;



let gauss_legendre_257_w = [| 0.00011191470145601756450862287886 ; 0.00026049995580176964436806680831 ; 0.00040926648283531339591138751432 ; 0.00055799120546880640169677292533 ;

 0.00070663671051592291949335494247 ; 0.00085517818446696565626595950963 ; 0.00100359280467969441299468763292 ; 0.0011518582377826677880963146741 ; 0.0012999523174235227389668643832 ;

 0.0014478529559255120065233994722 ; 0.0015955381166175133369701690235 ; 0.0017429858051468299509941139300 ; 0.0018901740676190104269878470891 ; 0.0020370809914723626741694800322 ;

 0.0021836847075455253317921866057 ; 0.0023299633927021828561308282641 ; 0.0024758952727301488651840215879 ; 0.0026214586253808109266552781372 ; 0.0027666317834818283552560256501 ;

 0.0029113931380877846359302447381 ; 0.0030557211416493711130936102459 ; 0.0031995943111899437356540290142 ; 0.0033429912314827618499065991316 ; 0.0034858905582247143702551557840 ;

 0.0036282710212037760873102463983 ; 0.0037701114274582873548537007645 ; 0.0039113906644266662571543468015 ; 0.0040520877030864825223229951262 ; 0.0041921816010820254766367595011 ;

 0.0043316515058396297504806208252 ; 0.0044704766576701092218388764046 ; 0.0046086363928577081326523656522 ; 0.0047461101467350184936945641585 ; 0.0048828774567433411142588306018 ;

 0.0050189179654779878773297516544 ; 0.0051542114237180378340642003713 ; 0.0052887376934400710240953933529 ; 0.0054224767508154127788846727083 ; 0.0055554086891904284012033890901 ;

 0.0056875137220494140577838938236 ; 0.0058187721859596348346566361185 ; 0.0059491645434980654366600347567 ; 0.0060786713861593931405204596709 ; 0.0062072734372448464599330978665 ;

 0.0063349515547314166407936938524 ; 0.0064616867341210426397202932350 ; 0.0065874601112693336961737372300 ; 0.0067122529651934070221351960200 ; 0.0068360467208584215286561508406 ;

 0.0069588229519423919043121805236 ; 0.0070805633835788707705149901066 ; 0.0072012498950770900730828552207 ; 0.0073208645226191563361371026044 ; 0.0074393894619338979090297315972 ;

 0.0075568070709469658838993300454 ; 0.0076730998724067939537782250476 ; 0.0077882505564860261212726654404 ; 0.0079022419833580248574070864277 ; 0.0080150571857480760504667455353 ;

 0.0081266793714589108764118189068 ; 0.0082370919258701685661946145361 ; 0.0083462784144114279413811886655 ; 0.0084542225850084395379670551258 ; 0.0085609083705021941391459209280 ;

 0.0086663198910404675908861979240 ; 0.0087704414564414858792445834744 ; 0.0088732575685293586050755892934 ; 0.0089747529234409331997949023068 ; 0.0090749124139037264846862498962 ;

 0.0091737211314845944854270065178 ; 0.0092711643688088057725325917169 ; 0.0093672276217491880067391857021 ; 0.0094618965915850218253881576301 ; 0.0095551571871303607110514249099 ;

 0.0096469955268314600363329731559 ; 0.0097373979408330030783691793250 ; 0.0098263509730128164423854701706 ; 0.0099138413829847720250916955489 ; 0.0099998561480695773850435626986 ;

 0.0100843824652331611676814627839 ; 0.0101674077529923650568895461852 ; 0.0102489196532876585918958554047 ; 0.0103289060333225980974485876288 ; 0.0104073549873697559257355517893 ;

 0.0104842548385428511997370260353 ; 0.0105595941405348182788823332058 ; 0.0106333616793215542382761147904 ; 0.0107055464748310917616231511294 ; 0.0107761377825779489945556541150 ;

 0.0108451250952624130885928632830 ; 0.0109124981443345193856719616965 ; 0.0109782469015224934483083029166 ; 0.0110423615803254284301924654946 ; 0.0111048326374699756056269264803 ;

 0.0111656507743308312328559850485 ; 0.0112248069383148083152535688671 ; 0.0112822923242082872447042603128 ; 0.0113380983754878447625379269120 ; 0.011392216785593866154247619654 ;

 0.011444639499166951104119199270 ; 0.011495358713246929174010288914 ; 0.011544366878434306436012137033 ; 0.011591656700013970380783131035 ; 0.011637221139040985841125311445 ;

 0.011681053413388320313049670635 ; 0.011723146998756342723302879656 ; 0.011763495629643945382264331878 ; 0.011802093300281144573421477037 ; 0.011838934265523020964443424791 ;

 0.011874013041704866779344562066 ; 0.011907324407458412445505183140 ; 0.011938863404489011222535627643 ; 0.011968625338313666131272065445 ; 0.011996605778959789329711050159 ;

 0.012022800561624589927558893338 ; 0.012047205787294992091420946532 ; 0.012069817823327991167612855626 ; 0.012090633303991361438266420912 ; 0.012109649130964635027950450318 ;

 0.012126862473800277391553601370 ; 0.012142270770344990738801546574 ; 0.012155871727121082685623083829 ; 0.012167663319667843366755737416 ; 0.012177643792842880196606249581 ;

 0.012185811661083365425569178819 ; 0.012192165708627157605870499188 ; 0.012196704989693764053654538465 ; 0.012199428828625117371582840212 ; 0.01220033681998614507777289232 ;

 0.012199428828625117371582840212 ; 0.012196704989693764053654538465 ; 0.012192165708627157605870499188 ; 0.012185811661083365425569178819 ; 0.012177643792842880196606249581 ;

 0.012167663319667843366755737416 ; 0.012155871727121082685623083829 ; 0.012142270770344990738801546574 ; 0.012126862473800277391553601370 ; 0.012109649130964635027950450318 ;

 0.012090633303991361438266420912 ; 0.012069817823327991167612855626 ; 0.012047205787294992091420946532 ; 0.012022800561624589927558893338 ; 0.011996605778959789329711050159 ;

 0.011968625338313666131272065445 ; 0.011938863404489011222535627643 ; 0.011907324407458412445505183140 ; 0.011874013041704866779344562066 ; 0.011838934265523020964443424791 ;

 0.011802093300281144573421477037 ; 0.011763495629643945382264331878 ; 0.011723146998756342723302879656 ; 0.011681053413388320313049670635 ; 0.011637221139040985841125311445 ;

 0.011591656700013970380783131035 ; 0.011544366878434306436012137033 ; 0.011495358713246929174010288914 ; 0.011444639499166951104119199270 ; 0.011392216785593866154247619654 ;

 0.0113380983754878447625379269120 ; 0.0112822923242082872447042603128 ; 0.0112248069383148083152535688671 ; 0.0111656507743308312328559850485 ; 0.0111048326374699756056269264803 ;

 0.0110423615803254284301924654946 ; 0.0109782469015224934483083029166 ; 0.0109124981443345193856719616965 ; 0.0108451250952624130885928632830 ; 0.0107761377825779489945556541150 ;

 0.0107055464748310917616231511294 ; 0.0106333616793215542382761147904 ; 0.0105595941405348182788823332058 ; 0.0104842548385428511997370260353 ; 0.0104073549873697559257355517893 ;

 0.0103289060333225980974485876288 ; 0.0102489196532876585918958554047 ; 0.0101674077529923650568895461852 ; 0.0100843824652331611676814627839 ; 0.0099998561480695773850435626986 ;

 0.0099138413829847720250916955489 ; 0.0098263509730128164423854701706 ; 0.0097373979408330030783691793250 ; 0.0096469955268314600363329731559 ; 0.0095551571871303607110514249099 ;

 0.0094618965915850218253881576301 ; 0.0093672276217491880067391857021 ; 0.0092711643688088057725325917169 ; 0.0091737211314845944854270065178 ; 0.0090749124139037264846862498962 ;

 0.0089747529234409331997949023068 ; 0.0088732575685293586050755892934 ; 0.0087704414564414858792445834744 ; 0.0086663198910404675908861979240 ; 0.0085609083705021941391459209280 ;

 0.0084542225850084395379670551258 ; 0.0083462784144114279413811886655 ; 0.0082370919258701685661946145361 ; 0.0081266793714589108764118189068 ; 0.0080150571857480760504667455353 ;

 0.0079022419833580248574070864277 ; 0.0077882505564860261212726654404 ; 0.0076730998724067939537782250476 ; 0.0075568070709469658838993300454 ; 0.0074393894619338979090297315972 ;

 0.0073208645226191563361371026044 ; 0.0072012498950770900730828552207 ; 0.0070805633835788707705149901066 ; 0.0069588229519423919043121805236 ; 0.0068360467208584215286561508406 ;

 0.0067122529651934070221351960200 ; 0.0065874601112693336961737372300 ; 0.0064616867341210426397202932350 ; 0.0063349515547314166407936938524 ; 0.0062072734372448464599330978665 ;

 0.0060786713861593931405204596709 ; 0.0059491645434980654366600347567 ; 0.0058187721859596348346566361185 ; 0.0056875137220494140577838938236 ; 0.0055554086891904284012033890901 ;

 0.0054224767508154127788846727083 ; 0.0052887376934400710240953933529 ; 0.0051542114237180378340642003713 ; 0.0050189179654779878773297516544 ; 0.0048828774567433411142588306018 ;

 0.0047461101467350184936945641585 ; 0.0046086363928577081326523656522 ; 0.0044704766576701092218388764046 ; 0.0043316515058396297504806208252 ; 0.0041921816010820254766367595011 ;

 0.0040520877030864825223229951262 ; 0.0039113906644266662571543468015 ; 0.0037701114274582873548537007645 ; 0.0036282710212037760873102463983 ; 0.0034858905582247143702551557840 ;

 0.0033429912314827618499065991316 ; 0.0031995943111899437356540290142 ; 0.0030557211416493711130936102459 ; 0.0029113931380877846359302447381 ; 0.0027666317834818283552560256501 ;

 0.0026214586253808109266552781372 ; 0.0024758952727301488651840215879 ; 0.0023299633927021828561308282641 ; 0.0021836847075455253317921866057 ; 0.0020370809914723626741694800322 ;

 0.0018901740676190104269878470891 ; 0.0017429858051468299509941139300 ; 0.0015955381166175133369701690235 ; 0.0014478529559255120065233994722 ; 0.0012999523174235227389668643832 ;

 0.0011518582377826677880963146741 ; 0.00100359280467969441299468763292 ; 0.00085517818446696565626595950963 ; 0.00070663671051592291949335494247 ; 0.00055799120546880640169677292533 ;

 0.00040926648283531339591138751432 ; 0.00026049995580176964436806680831 ; 0.00011191470145601756450862287886 |] ;;





let gauss_patterson_1_x = [| 0.0 |] ;;



let gauss_patterson_1_w = [| 2.0 |] ;;





let gauss_patterson_3_x = [| -0.77459666924148337704 ; 0.0 ; 0.77459666924148337704 |] ;;



let gauss_patterson_3_w = [| 0.555555555555555555556 ; 0.888888888888888888889 ; 0.555555555555555555556 |] ;;





let gauss_patterson_7_x = [| -0.96049126870802028342 ; -0.77459666924148337704 ; -0.43424374934680255800 ;

 0.0 ; 0.43424374934680255800 ; 0.77459666924148337704 ; 0.96049126870802028342 |] ;;



let gauss_patterson_7_w = [| 0.104656226026467265194 ; 0.268488089868333440729 ; 0.401397414775962222905 ;

 0.450916538658474142345 ; 0.401397414775962222905 ; 0.268488089868333440729 ; 0.104656226026467265194 |] ;;





let gauss_patterson_15_x = [| -0.99383196321275502221 ; -0.96049126870802028342 ; -0.88845923287225699889 ;

 -0.77459666924148337704 ; -0.62110294673722640294 ; -0.43424374934680255800 ; -0.22338668642896688163 ;

 0.0 ;  0.22338668642896688163 ;  0.43424374934680255800 ;  0.62110294673722640294 ;

 0.77459666924148337704 ;  0.88845923287225699889 ;  0.96049126870802028342 ;  0.99383196321275502221 |] ;;



let gauss_patterson_15_w = [| 0.0170017196299402603390 ; 0.0516032829970797396969 ;  0.0929271953151245376859 ;

 0.134415255243784220360 ; 0.171511909136391380787 ; 0.200628529376989021034 ; 0.219156858401587496404 ;

 0.225510499798206687386 ; 0.219156858401587496404 ; 0.200628529376989021034 ; 0.171511909136391380787 ; 

 0.134415255243784220360 ; 0.0929271953151245376859 ; 0.0516032829970797396969 ; 0.0170017196299402603390 |] ;; 





let gauss_patterson_31_x = [| -0.99909812496766759766 ; -0.99383196321275502221 ; -0.98153114955374010687 ;

 -0.96049126870802028342 ; -0.92965485742974005667 ; -0.88845923287225699889 ; -0.83672593816886873550 ;

 -0.77459666924148337704 ; -0.70249620649152707861 ; -0.62110294673722640294 ; -0.53131974364437562397 ;

 -0.43424374934680255800 ; -0.33113539325797683309 ; -0.22338668642896688163 ; -0.11248894313318662575 ; 

 0.0 ; 0.11248894313318662575 ; 0.22338668642896688163 ; 0.33113539325797683309 ; 0.43424374934680255800 ;

 0.53131974364437562397 ; 0.62110294673722640294 ; 0.70249620649152707861 ; 0.77459666924148337704 ;

 0.83672593816886873550 ; 0.88845923287225699889 ; 0.92965485742974005667 ; 0.96049126870802028342 ; 

 0.98153114955374010687 ; 0.99383196321275502221 ; 0.99909812496766759766 |] ;;



let gauss_patterson_31_w = [| 0.00254478079156187441540 ; 0.00843456573932110624631 ; 0.0164460498543878109338 ;

 0.0258075980961766535646 ; 0.0359571033071293220968 ; 0.0464628932617579865414 ; 0.0569795094941233574122 ;

 0.0672077542959907035404 ; 0.0768796204990035310427 ; 0.0857559200499903511542 ; 0.0936271099812644736167 ;

 0.100314278611795578771 ; 0.105669893580234809744 ; 0.109578421055924638237 ; 0.111956873020953456880 ;

 0.112755256720768691607 ; 0.111956873020953456880 ; 0.109578421055924638237 ; 0.105669893580234809744 ;

 0.100314278611795578771 ; 0.0936271099812644736167 ; 0.0857559200499903511542 ; 0.0768796204990035310427 ;

 0.0672077542959907035404 ; 0.0569795094941233574122 ; 0.0464628932617579865414 ; 0.0359571033071293220968 ;

 0.0258075980961766535646 ; 0.0164460498543878109338 ; 0.00843456573932110624631 ; 0.00254478079156187441540 |] ;;





let gauss_patterson_63_x = [| -0.99987288812035761194 ; -0.99909812496766759766 ; -0.99720625937222195908 ;

 -0.99383196321275502221 ; -0.98868475754742947994 ; -0.98153114955374010687 ; -0.97218287474858179658 ;

 -0.96049126870802028342 ; -0.94634285837340290515 ; -0.92965485742974005667 ; -0.91037115695700429250 ;

 -0.88845923287225699889 ; -0.86390793819369047715 ; -0.83672593816886873550 ; -0.80694053195021761186 ;

 -0.77459666924148337704 ; -0.73975604435269475868 ; -0.70249620649152707861 ; -0.66290966002478059546 ;

 -0.62110294673722640294 ; -0.57719571005204581484 ; -0.53131974364437562397 ; -0.48361802694584102756 ;

 -0.43424374934680255800 ; -0.38335932419873034692 ; -0.33113539325797683309 ; -0.27774982202182431507 ;

 -0.22338668642896688163 ; -0.16823525155220746498 ; -0.11248894313318662575 ; -0.056344313046592789972 ;

 0.0 ; 0.056344313046592789972 ; 0.11248894313318662575 ; 0.16823525155220746498 ; 0.22338668642896688163 ;

 0.27774982202182431507 ; 0.33113539325797683309 ; 0.38335932419873034692 ; 0.43424374934680255800 ;

 0.48361802694584102756 ; 0.53131974364437562397 ; 0.57719571005204581484 ; 0.62110294673722640294 ;

 0.66290966002478059546 ; 0.70249620649152707861 ; 0.73975604435269475868 ; 0.77459666924148337704 ;

 0.80694053195021761186 ; 0.83672593816886873550 ; 0.86390793819369047715 ; 0.88845923287225699889 ;

 0.91037115695700429250 ; 0.92965485742974005667 ; 0.94634285837340290515 ; 0.96049126870802028342 ;

 0.97218287474858179658 ; 0.98153114955374010687 ; 0.98868475754742947994 ; 0.99383196321275502221 ;

 0.99720625937222195908 ; 0.99909812496766759766 ; 0.99987288812035761194 |] ;;



let gauss_patterson_63_w = [| 0.000363221481845530659694 ; 0.00126515655623006801137 ; 0.00257904979468568827243 ;

 0.00421763044155885483908 ; 0.00611550682211724633968 ; 0.00822300795723592966926 ; 0.0104982469096213218983 ;

 0.0129038001003512656260 ; 0.0154067504665594978021 ; 0.0179785515681282703329 ; 0.0205942339159127111492 ;

 0.0232314466399102694433 ; 0.0258696793272147469108 ; 0.0284897547458335486125 ; 0.0310735511116879648799 ;

 0.0336038771482077305417 ; 0.0360644327807825726401 ; 0.0384398102494555320386 ; 0.0407155101169443189339 ;

 0.0428779600250077344929 ; 0.0449145316536321974143 ; 0.0468135549906280124026 ; 0.0485643304066731987159 ;

 0.0501571393058995374137 ; 0.0515832539520484587768 ; 0.0528349467901165198621 ; 0.0539054993352660639269 ;

 0.0547892105279628650322 ; 0.0554814043565593639878 ; 0.0559784365104763194076 ; 0.0562776998312543012726 ;

 0.0563776283603847173877 ; 0.0562776998312543012726 ; 0.0559784365104763194076 ; 0.0554814043565593639878 ;

 0.0547892105279628650322 ; 0.0539054993352660639269 ; 0.0528349467901165198621 ; 0.0515832539520484587768 ;

 0.0501571393058995374137 ; 0.0485643304066731987159 ; 0.0468135549906280124026 ; 0.0449145316536321974143 ;

 0.0428779600250077344929 ; 0.0407155101169443189339 ; 0.0384398102494555320386 ; 0.0360644327807825726401 ;

 0.0336038771482077305417 ; 0.0310735511116879648799 ; 0.0284897547458335486125 ; 0.0258696793272147469108 ;

 0.0232314466399102694433 ; 0.0205942339159127111492 ; 0.0179785515681282703329 ; 0.0154067504665594978021 ;

 0.0129038001003512656260 ; 0.0104982469096213218983 ; 0.00822300795723592966926 ; 0.00611550682211724633968 ;

 0.00421763044155885483908 ; 0.00257904979468568827243 ; 0.00126515655623006801137 ; 0.000363221481845530659694 |] ;;





let gauss_patterson_127_x = [| -0.99998243035489159858 ; -0.99987288812035761194 ; -0.99959879967191068325 ;

 -0.99909812496766759766 ; -0.99831663531840739253 ; -0.99720625937222195908 ; -0.99572410469840718851 ;

 -0.99383196321275502221 ; -0.99149572117810613240 ; -0.98868475754742947994 ; -0.98537149959852037111 ;

 -0.98153114955374010687 ; -0.97714151463970571416 ; -0.97218287474858179658 ; -0.96663785155841656709 ;

 -0.96049126870802028342 ; -0.95373000642576113641 ; -0.94634285837340290515 ; -0.93832039777959288365 ;

 -0.92965485742974005667 ; -0.92034002547001242073 ; -0.91037115695700429250 ; -0.89974489977694003664 ;

 -0.88845923287225699889 ; -0.87651341448470526974 ; -0.86390793819369047715 ; -0.85064449476835027976 ;

 -0.83672593816886873550 ; -0.82215625436498040737 ; -0.80694053195021761186 ; -0.79108493379984836143 ;

 -0.77459666924148337704 ; -0.75748396638051363793 ; -0.73975604435269475868 ; -0.72142308537009891548 ;

 -0.70249620649152707861 ; -0.68298743109107922809 ; -0.66290966002478059546 ; -0.64227664250975951377 ;

 -0.62110294673722640294 ; -0.59940393024224289297 ; -0.57719571005204581484 ; -0.55449513263193254887 ;

 -0.53131974364437562397 ; -0.50768775753371660215 ; -0.48361802694584102756 ; -0.45913001198983233287 ;

 -0.43424374934680255800 ; -0.40897982122988867241 ; -0.38335932419873034692 ; -0.35740383783153215238 ;

 -0.33113539325797683309 ; -0.30457644155671404334 ; -0.27774982202182431507 ; -0.25067873030348317661 ;

 -0.22338668642896688163 ; -0.19589750271110015392 ; -0.16823525155220746498 ; -0.14042423315256017459 ;

 -0.11248894313318662575 ; -0.084454040083710883710 ; -0.056344313046592789972 ; -0.028184648949745694339 ;

 0.0 ; 0.028184648949745694339 ; 0.056344313046592789972 ; 0.084454040083710883710 ; 0.11248894313318662575 ;

 0.14042423315256017459 ; 0.16823525155220746498 ; 0.19589750271110015392 ; 0.22338668642896688163 ;

 0.25067873030348317661 ; 0.27774982202182431507 ; 0.30457644155671404334 ; 0.33113539325797683309 ;

 0.35740383783153215238 ; 0.38335932419873034692 ; 0.40897982122988867241 ; 0.43424374934680255800 ;

 0.45913001198983233287 ; 0.48361802694584102756 ; 0.50768775753371660215 ; 0.53131974364437562397 ;

 0.55449513263193254887 ; 0.57719571005204581484 ; 0.59940393024224289297 ; 0.62110294673722640294 ;

 0.64227664250975951377 ; 0.66290966002478059546 ; 0.68298743109107922809 ; 0.70249620649152707861 ;

 0.72142308537009891548 ; 0.73975604435269475868 ; 0.75748396638051363793 ; 0.77459666924148337704 ;

 0.79108493379984836143 ; 0.80694053195021761186 ; 0.82215625436498040737 ; 0.83672593816886873550 ;

 0.85064449476835027976 ; 0.86390793819369047715 ; 0.87651341448470526974 ; 0.88845923287225699889 ;

 0.89974489977694003664 ; 0.91037115695700429250 ; 0.92034002547001242073 ; 0.92965485742974005667 ;

 0.93832039777959288365 ; 0.94634285837340290515 ; 0.95373000642576113641 ; 0.96049126870802028342 ;

 0.96663785155841656709 ; 0.97218287474858179658 ; 0.97714151463970571416 ; 0.98153114955374010687 ;

 0.98537149959852037111 ; 0.98868475754742947994 ; 0.99149572117810613240 ; 0.99383196321275502221 ;

 0.99572410469840718851 ; 0.99720625937222195908 ; 0.99831663531840739253 ; 0.99909812496766759766 ;

 0.99959879967191068325 ; 0.99987288812035761194 ; 0.99998243035489159858 |] ;;



let gauss_patterson_127_w = [| 0.0000505360952078625176247 ; 0.000180739564445388357820 ; 0.000377746646326984660274 ;

 0.000632607319362633544219 ; 0.000938369848542381500794 ; 0.00128952408261041739210 ; 0.00168114286542146990631 ;

 0.00210881524572663287933 ; 0.00256876494379402037313 ; 0.00305775341017553113613 ; 0.00357289278351729964938 ;

 0.00411150397865469304717 ; 0.00467105037211432174741 ; 0.00524912345480885912513 ; 0.00584344987583563950756 ;

 0.00645190005017573692280 ; 0.00707248999543355546805 ; 0.00770337523327974184817 ; 0.00834283875396815770558 ;

 0.00898927578406413572328 ; 0.00964117772970253669530 ; 0.0102971169579563555237 ; 0.0109557333878379016480 ;

 0.0116157233199551347270 ; 0.0122758305600827700870 ; 0.0129348396636073734547 ; 0.0135915710097655467896 ;

 0.0142448773729167743063 ; 0.0148936416648151820348 ; 0.0155367755558439824399 ; 0.0161732187295777199419 ;

 0.0168019385741038652709 ; 0.0174219301594641737472 ; 0.0180322163903912863201 ; 0.0186318482561387901863 ;

 0.0192199051247277660193 ; 0.0197954950480974994880 ; 0.0203577550584721594669 ; 0.0209058514458120238522 ;

 0.0214389800125038672465 ; 0.0219563663053178249393 ; 0.0224572658268160987071 ; 0.0229409642293877487608 ;

 0.0234067774953140062013 ; 0.0238540521060385400804 ; 0.0242821652033365993580 ; 0.0246905247444876769091 ;

 0.0250785696529497687068 ; 0.0254457699654647658126 ; 0.0257916269760242293884 ; 0.0261156733767060976805 ;

 0.0264174733950582599310 ; 0.0266966229274503599062 ; 0.0269527496676330319634 ; 0.0271855132296247918192 ;

 0.0273946052639814325161 ; 0.0275797495664818730349 ; 0.0277407021782796819939 ; 0.0278772514766137016085 ;

 0.0279892182552381597038 ; 0.0280764557938172466068 ; 0.0281388499156271506363 ; 0.0281763190330166021307 ;

 0.0281888141801923586938 ; 0.0281763190330166021307 ; 0.0281388499156271506363 ; 0.0280764557938172466068 ;

 0.0279892182552381597038 ; 0.0278772514766137016085 ; 0.0277407021782796819939 ; 0.0275797495664818730349 ;

 0.0273946052639814325161 ; 0.0271855132296247918192 ; 0.0269527496676330319634 ; 0.0266966229274503599062 ;

 0.0264174733950582599310 ; 0.0261156733767060976805 ; 0.0257916269760242293884 ; 0.0254457699654647658126 ;

 0.0250785696529497687068 ; 0.0246905247444876769091 ; 0.0242821652033365993580 ; 0.0238540521060385400804 ;

 0.0234067774953140062013 ; 0.0229409642293877487608 ; 0.0224572658268160987071 ; 0.0219563663053178249393 ;

 0.0214389800125038672465 ; 0.0209058514458120238522 ; 0.0203577550584721594669 ; 0.0197954950480974994880 ;

 0.0192199051247277660193 ; 0.0186318482561387901863 ; 0.0180322163903912863201 ; 0.0174219301594641737472 ;

 0.0168019385741038652709 ; 0.0161732187295777199419 ; 0.0155367755558439824399 ; 0.0148936416648151820348 ;

 0.0142448773729167743063 ; 0.0135915710097655467896 ; 0.0129348396636073734547 ; 0.0122758305600827700870 ;

 0.0116157233199551347270 ; 0.0109557333878379016480 ; 0.0102971169579563555237 ; 0.00964117772970253669530 ;

 0.00898927578406413572328 ; 0.00834283875396815770558 ; 0.00770337523327974184817 ; 0.00707248999543355546805 ;

 0.00645190005017573692280 ; 0.00584344987583563950756 ; 0.00524912345480885912513 ; 0.00467105037211432174741 ;

 0.00411150397865469304717 ; 0.00357289278351729964938 ; 0.00305775341017553113613 ; 0.00256876494379402037313 ;

 0.00210881524572663287933 ; 0.00168114286542146990631 ; 0.00128952408261041739210 ; 0.000938369848542381500794 ;

 0.000632607319362633544219 ; 0.000377746646326984660274 ; 0.000180739564445388357820 ; 0.0000505360952078625176247 |] ;;





let gauss_patterson_255_x = [| -0.99999759637974846462 ; -0.99998243035489159858 ; -0.99994399620705437576 ; -0.99987288812035761194 ;

 -0.99976049092443204733 ; -0.99959879967191068325 ; -0.99938033802502358193 ; -0.99909812496766759766 ; -0.99874561446809511470 ;

 -0.99831663531840739253 ; -0.99780535449595727456 ; -0.99720625937222195908 ; -0.99651414591489027385 ; -0.99572410469840718851 ;

 -0.99483150280062100052 ; -0.99383196321275502221 ; -0.99272134428278861533 ; -0.99149572117810613240 ; -0.99015137040077015918 ;

 -0.98868475754742947994 ; -0.98709252795403406719 ; -0.98537149959852037111 ; -0.98351865757863272876 ; -0.98153114955374010687 ;

 -0.97940628167086268381 ; -0.97714151463970571416 ; -0.97473445975240266776 ; -0.97218287474858179658 ; -0.96948465950245923177 ;

 -0.96663785155841656709 ; -0.96364062156981213252 ; -0.96049126870802028342 ; -0.95718821610986096274 ; -0.95373000642576113641 ;

 -0.95011529752129487656 ; -0.94634285837340290515 ; -0.94241156519108305981 ; -0.93832039777959288365 ; -0.93406843615772578800 ;

 -0.92965485742974005667 ; -0.92507893290707565236 ; -0.92034002547001242073 ; -0.91543758715576504064 ; -0.91037115695700429250 ;

 -0.90514035881326159519 ; -0.89974489977694003664 ; -0.89418456833555902286 ; -0.88845923287225699889 ; -0.88256884024734190684 ;

 -0.87651341448470526974 ; -0.87029305554811390585 ; -0.86390793819369047715 ; -0.85735831088623215653 ; -0.85064449476835027976 ;

 -0.84376688267270860104 ; -0.83672593816886873550 ; -0.82952219463740140018 ; -0.82215625436498040737 ; -0.81462878765513741344 ;

 -0.80694053195021761186 ; -0.79909229096084140180 ; -0.79108493379984836143 ; -0.78291939411828301639 ; -0.77459666924148337704 ;

 -0.76611781930376009072 ; -0.75748396638051363793 ; -0.74869629361693660282 ; -0.73975604435269475868 ; -0.73066452124218126133 ;

 -0.72142308537009891548 ; -0.71203315536225203459 ; -0.70249620649152707861 ; -0.69281376977911470289 ; -0.68298743109107922809 ;

 -0.67301883023041847920 ; -0.66290966002478059546 ; -0.65266166541001749610 ; -0.64227664250975951377 ; -0.63175643771119423041 ;

 -0.62110294673722640294 ; -0.61031811371518640016 ; -0.59940393024224289297 ; -0.58836243444766254143 ; -0.57719571005204581484 ;

 -0.56590588542365442262 ; -0.55449513263193254887 ; -0.54296566649831149049 ; -0.53131974364437562397 ; -0.51955966153745702199 ;

 -0.50768775753371660215 ; -0.49570640791876146017 ; -0.48361802694584102756 ; -0.47142506587165887693 ; -0.45913001198983233287 ;

 -0.44673538766202847374 ; -0.43424374934680255800 ; -0.42165768662616330006 ; -0.40897982122988867241 ; -0.39621280605761593918 ;

 -0.38335932419873034692 ; -0.37042208795007823014 ; -0.35740383783153215238 ; -0.34430734159943802278 ; -0.33113539325797683309 ;

 -0.31789081206847668318 ; -0.30457644155671404334 ; -0.29119514851824668196 ; -0.27774982202182431507 ; -0.26424337241092676194 ;

 -0.25067873030348317661 ; -0.23705884558982972721 ; -0.22338668642896688163 ; -0.20966523824318119477 ; -0.19589750271110015392 ;

 -0.18208649675925219825 ; -0.16823525155220746498 ; -0.15434681148137810869 ; -0.14042423315256017459 ; -0.12647058437230196685 ;

 -0.11248894313318662575 ; -0.098482396598119202090 ; -0.084454040083710883710 ; -0.070406976042855179063 ; -0.056344313046592789972 ;

 -0.042269164765363603212 ; -0.028184648949745694339 ; -0.014093886410782462614 ;  0.0 ;  0.014093886410782462614 ;  0.028184648949745694339 ;

 0.042269164765363603212 ;  0.056344313046592789972 ;  0.070406976042855179063 ;  0.084454040083710883710 ;  0.098482396598119202090 ; 

 0.11248894313318662575 ;  0.12647058437230196685 ;  0.14042423315256017459 ;  0.15434681148137810869 ;  0.16823525155220746498 ;

 0.18208649675925219825 ;  0.19589750271110015392 ;  0.20966523824318119477 ;  0.22338668642896688163 ;  0.23705884558982972721 ;

 0.25067873030348317661 ;  0.26424337241092676194 ;  0.27774982202182431507 ;  0.29119514851824668196 ;  0.30457644155671404334 ;

 0.31789081206847668318 ;  0.33113539325797683309 ;  0.34430734159943802278 ;  0.35740383783153215238 ;  0.37042208795007823014 ;

 0.38335932419873034692 ;  0.39621280605761593918 ;  0.40897982122988867241 ;  0.42165768662616330006 ;  0.43424374934680255800 ;

 0.44673538766202847374 ;  0.45913001198983233287 ;  0.47142506587165887693 ;  0.48361802694584102756 ;  0.49570640791876146017 ;

 0.50768775753371660215 ;  0.51955966153745702199 ;  0.53131974364437562397 ;  0.54296566649831149049 ;  0.55449513263193254887 ;

 0.56590588542365442262 ;  0.57719571005204581484 ;  0.58836243444766254143 ;  0.59940393024224289297 ;  0.61031811371518640016 ;

 0.62110294673722640294 ;  0.63175643771119423041 ;  0.64227664250975951377 ;  0.65266166541001749610 ;  0.66290966002478059546 ;

 0.67301883023041847920 ;  0.68298743109107922809 ;  0.69281376977911470289 ;  0.70249620649152707861 ;  0.71203315536225203459 ;

 0.72142308537009891548 ;  0.73066452124218126133 ;  0.73975604435269475868 ;  0.74869629361693660282 ;  0.75748396638051363793 ;

 0.76611781930376009072 ;  0.77459666924148337704 ;  0.78291939411828301639 ;  0.79108493379984836143 ;  0.79909229096084140180 ;

 0.80694053195021761186 ;  0.81462878765513741344 ;  0.82215625436498040737 ;  0.82952219463740140018 ;  0.83672593816886873550 ;

 0.84376688267270860104 ;  0.85064449476835027976 ;  0.85735831088623215653 ;  0.86390793819369047715 ;  0.87029305554811390585 ;

 0.87651341448470526974 ;  0.88256884024734190684 ;  0.88845923287225699889 ;  0.89418456833555902286 ;  0.89974489977694003664 ;

 0.90514035881326159519 ;  0.91037115695700429250 ;  0.91543758715576504064 ;  0.92034002547001242073 ;  0.92507893290707565236 ;

 0.92965485742974005667 ;  0.93406843615772578800 ;  0.93832039777959288365 ;  0.94241156519108305981 ;  0.94634285837340290515 ;

 0.95011529752129487656 ;  0.95373000642576113641 ;  0.95718821610986096274 ;  0.96049126870802028342 ;  0.96364062156981213252 ;

 0.96663785155841656709 ;  0.96948465950245923177 ;  0.97218287474858179658 ;  0.97473445975240266776 ;  0.97714151463970571416 ;

 0.97940628167086268381 ;  0.98153114955374010687 ;  0.98351865757863272876 ;  0.98537149959852037111 ;  0.98709252795403406719 ;

 0.98868475754742947994 ;  0.99015137040077015918 ;  0.99149572117810613240 ;  0.99272134428278861533 ;  0.99383196321275502221 ;

 0.99483150280062100052 ;  0.99572410469840718851 ;  0.99651414591489027385 ;  0.99720625937222195908 ;  0.99780535449595727456 ;

 0.99831663531840739253 ;  0.99874561446809511470 ;  0.99909812496766759766 ;  0.99938033802502358193 ;  0.99959879967191068325 ;

 0.99976049092443204733 ; 0.99987288812035761194 ; 0.99994399620705437576 ; 0.99998243035489159858 ; 0.99999759637974846462 |] ;;





let gauss_patterson_255_w = [| 0.69379364324108267170e-5 ; 0.25157870384280661489e-4 ; 0.53275293669780613125e-4 ; 0.90372734658751149261e-4 ; 0.13575491094922871973e-3

 ; 0.18887326450650491366e-3 ; 0.24921240048299729402e-3 ; 0.31630366082226447689e-3 ; 0.38974528447328229322e-3 ; 0.46918492424785040975e-3

 ; 0.55429531493037471492e-3 ; 0.64476204130572477933e-3 ; 0.74028280424450333046e-3 ; 0.84057143271072246365e-3 ; 0.94536151685852538246e-3

 ; 0.10544076228633167722e-2 ; 0.11674841174299594077e-2 ; 0.12843824718970101768e-2 ; 0.14049079956551446427e-2 ; 0.15288767050877655684e-2

 ; 0.16561127281544526052e-2 ; 0.17864463917586498247e-2 ; 0.19197129710138724125e-2 ; 0.20557519893273465236e-2 ; 0.21944069253638388388e-2

 ; 0.23355251860571608737e-2 ; 0.24789582266575679307e-2 ; 0.26245617274044295626e-2 ; 0.27721957645934509940e-2 ; 0.29217249379178197538e-2

 ; 0.30730184347025783234e-2 ; 0.32259500250878684614e-2 ; 0.33803979910869203823e-2 ; 0.35362449977167777340e-2 ; 0.36933779170256508183e-2

 ; 0.38516876166398709241e-2 ; 0.40110687240750233989e-2 ; 0.41714193769840788528e-2 ; 0.43326409680929828545e-2 ; 0.44946378920320678616e-2

 ; 0.46573172997568547773e-2 ; 0.48205888648512683476e-2 ; 0.49843645647655386012e-2 ; 0.51485584789781777618e-2 ; 0.53130866051870565663e-2

 ; 0.54778666939189508240e-2 ; 0.56428181013844441585e-2 ; 0.58078616599775673635e-2 ; 0.59729195655081658049e-2 ; 0.61379152800413850435e-2

 ; 0.63027734490857587172e-2 ; 0.64674198318036867274e-2 ; 0.66317812429018878941e-2 ; 0.67957855048827733948e-2 ; 0.69593614093904229394e-2

 ; 0.71224386864583871532e-2 ; 0.72849479805538070639e-2 ; 0.74468208324075910174e-2 ; 0.76079896657190565832e-2 ; 0.77683877779219912200e-2

 ; 0.79279493342948491103e-2 ; 0.80866093647888599710e-2 ; 0.82443037630328680306e-2 ; 0.84009692870519326354e-2 ; 0.85565435613076896192e-2

 ; 0.87109650797320868736e-2 ; 0.88641732094824942641e-2 ; 0.90161081951956431600e-2 ; 0.91667111635607884067e-2 ; 0.93159241280693950932e-2

 ; 0.94636899938300652943e-2 ; 0.96099525623638830097e-2 ; 0.97546565363174114611e-2 ; 0.98977475240487497440e-2 ; 0.10039172044056840798e-1

 ; 0.10178877529236079733e-1 ; 0.10316812330947621682e-1 ; 0.10452925722906011926e-1 ; 0.10587167904885197931e-1 ; 0.10719490006251933623e-1

 ; 0.10849844089337314099e-1 ; 0.10978183152658912470e-1 ; 0.11104461134006926537e-1 ; 0.11228632913408049354e-1 ; 0.11350654315980596602e-1

 ; 0.11470482114693874380e-1 ; 0.11588074033043952568e-1 ; 0.11703388747657003101e-1 ; 0.11816385890830235763e-1 ; 0.11927026053019270040e-1

 ; 0.12035270785279562630e-1 ; 0.12141082601668299679e-1 ; 0.12244424981611985899e-1 ; 0.12345262372243838455e-1 ; 0.12443560190714035263e-1

 ; 0.12539284826474884353e-1 ; 0.12632403643542078765e-1 ; 0.12722884982732382906e-1 ; 0.12810698163877361967e-1 ; 0.12895813488012114694e-1

 ; 0.12978202239537399286e-1 ; 0.13057836688353048840e-1 ; 0.13134690091960152836e-1 ; 0.13208736697529129966e-1 ; 0.13279951743930530650e-1

 ; 0.13348311463725179953e-1 ; 0.13413793085110098513e-1 ; 0.13476374833816515982e-1 ; 0.13536035934956213614e-1 ; 0.13592756614812395910e-1

 ; 0.13646518102571291428e-1 ; 0.13697302631990716258e-1 ; 0.13745093443001896632e-1 ; 0.13789874783240936517e-1 ; 0.13831631909506428676e-1

 ; 0.13870351089139840997e-1 ; 0.13906019601325461264e-1 ; 0.13938625738306850804e-1 ; 0.13968158806516938516e-1 ; 0.13994609127619079852e-1

 ; 0.14017968039456608810e-1 ; 0.14038227896908623303e-1 ; 0.14055382072649964277e-1 ; 0.14069424957813575318e-1 ; 0.14080351962553661325e-1

 ; 0.14088159516508301065e-1 ; 0.14092845069160408355e-1 ; 0.14094407090096179347e-1 ; 0.14092845069160408355e-1 ; 0.14088159516508301065e-1

 ; 0.14080351962553661325e-1 ; 0.14069424957813575318e-1 ; 0.14055382072649964277e-1 ; 0.14038227896908623303e-1 ; 0.14017968039456608810e-1

 ; 0.13994609127619079852e-1 ; 0.13968158806516938516e-1 ; 0.13938625738306850804e-1 ; 0.13906019601325461264e-1 ; 0.13870351089139840997e-1

 ; 0.13831631909506428676e-1 ; 0.13789874783240936517e-1 ; 0.13745093443001896632e-1 ; 0.13697302631990716258e-1 ; 0.13646518102571291428e-1

 ; 0.13592756614812395910e-1 ; 0.13536035934956213614e-1 ; 0.13476374833816515982e-1 ; 0.13413793085110098513e-1 ; 0.13348311463725179953e-1

 ; 0.13279951743930530650e-1 ; 0.13208736697529129966e-1 ; 0.13134690091960152836e-1 ; 0.13057836688353048840e-1 ; 0.12978202239537399286e-1

 ; 0.12895813488012114694e-1 ; 0.12810698163877361967e-1 ; 0.12722884982732382906e-1 ; 0.12632403643542078765e-1 ; 0.12539284826474884353e-1

 ; 0.12443560190714035263e-1 ; 0.12345262372243838455e-1 ; 0.12244424981611985899e-1 ; 0.12141082601668299679e-1 ; 0.12035270785279562630e-1

 ; 0.11927026053019270040e-1 ; 0.11816385890830235763e-1 ; 0.11703388747657003101e-1 ; 0.11588074033043952568e-1 ; 0.11470482114693874380e-1

 ; 0.11350654315980596602e-1 ; 0.11228632913408049354e-1 ; 0.11104461134006926537e-1 ; 0.10978183152658912470e-1 ; 0.10849844089337314099e-1

 ; 0.10719490006251933623e-1 ; 0.10587167904885197931e-1 ; 0.10452925722906011926e-1 ; 0.10316812330947621682e-1 ; 0.10178877529236079733e-1

 ; 0.10039172044056840798e-1 ; 0.98977475240487497440e-2 ; 0.97546565363174114611e-2 ; 0.96099525623638830097e-2 ; 0.94636899938300652943e-2

 ; 0.93159241280693950932e-2 ; 0.91667111635607884067e-2 ; 0.90161081951956431600e-2 ; 0.88641732094824942641e-2 ; 0.87109650797320868736e-2

 ; 0.85565435613076896192e-2 ; 0.84009692870519326354e-2 ; 0.82443037630328680306e-2 ; 0.80866093647888599710e-2 ; 0.79279493342948491103e-2

 ; 0.77683877779219912200e-2 ; 0.76079896657190565832e-2 ; 0.74468208324075910174e-2 ; 0.72849479805538070639e-2 ; 0.71224386864583871532e-2

 ; 0.69593614093904229394e-2 ; 0.67957855048827733948e-2 ; 0.66317812429018878941e-2 ; 0.64674198318036867274e-2 ; 0.63027734490857587172e-2

 ; 0.61379152800413850435e-2 ; 0.59729195655081658049e-2 ; 0.58078616599775673635e-2 ; 0.56428181013844441585e-2 ; 0.54778666939189508240e-2

 ; 0.53130866051870565663e-2 ; 0.51485584789781777618e-2 ; 0.49843645647655386012e-2 ; 0.48205888648512683476e-2 ; 0.46573172997568547773e-2

 ; 0.44946378920320678616e-2 ; 0.43326409680929828545e-2 ; 0.41714193769840788528e-2 ; 0.40110687240750233989e-2 ; 0.38516876166398709241e-2

 ; 0.36933779170256508183e-2 ; 0.35362449977167777340e-2 ; 0.33803979910869203823e-2 ; 0.32259500250878684614e-2 ; 0.30730184347025783234e-2

 ; 0.29217249379178197538e-2 ; 0.27721957645934509940e-2 ; 0.26245617274044295626e-2 ; 0.24789582266575679307e-2 ; 0.23355251860571608737e-2

 ; 0.21944069253638388388e-2 ; 0.20557519893273465236e-2 ; 0.19197129710138724125e-2 ; 0.17864463917586498247e-2 ; 0.16561127281544526052e-2

 ; 0.15288767050877655684e-2 ; 0.14049079956551446427e-2 ; 0.12843824718970101768e-2 ; 0.11674841174299594077e-2 ; 0.10544076228633167722e-2

 ; 0.94536151685852538246e-3 ; 0.84057143271072246365e-3 ; 0.74028280424450333046e-3 ; 0.64476204130572477933e-3 ; 0.55429531493037471492e-3

 ; 0.46918492424785040975e-3 ; 0.38974528447328229322e-3 ; 0.31630366082226447689e-3 ; 0.24921240048299729402e-3 ; 0.18887326450650491366e-3

 ; 0.13575491094922871973e-3 ; 0.90372734658751149261e-4 ; 0.53275293669780613125e-4 ; 0.25157870384280661489e-4 ; 0.69379364324108267170e-5 |] ;;





let lobatto_2_x = [|  - 1.0 ; 1.0 |] ;;



let lobatto_2_w = [|  1.0 ; 1.0 |] ;;





let lobatto_3_x = [|  - 1.0 ; 0.0 ; 1.0 |] ;;



let lobatto_3_w = [|  1.0 /. 3.0 ; 4.0 /. 3.0 ; 1.0 /. 3.0 |] ;;





let lobatto_4_x = [|  - 1.0 ; - 0.447213595499957939281834733746 ; 0.447213595499957939281834733746 ; 1.0 |] ;;



let lobatto_4_w = [|  1.0 /. 6.0 ; 5.0 /. 6.0 ; 5.0 /. 6.0 ; 1.0 /. 6.0 |] ;;





let lobatto_5_x = [|  - 1.0 ; - 0.654653670707977143798292456247 ; 0.0 ; 0.654653670707977143798292456247 ; 1.0 |] ;;



let lobatto_5_w = [|  9.0 /. 90.0 ; 49.0 /. 90.0 ; 64.0 /. 90.0 ; 49.0 /. 90.0 ; 9.0 /. 90.0 |] ;;





let lobatto_6_x = [|  - 1.0 ; - 0.765055323929464692851002973959 ; - 0.285231516480645096314150994041 ;

 0.285231516480645096314150994041 ; 0.765055323929464692851002973959 ; 1.0 |] ;;



let lobatto_6_w = [|  0.066666666666666666666666666667 ; 0.378474956297846980316612808212 ; 0.554858377035486353016720525121 ;

 0.554858377035486353016720525121 ; 0.378474956297846980316612808212 ; 0.066666666666666666666666666667 |] ;;





let lobatto_7_x = [|  - 1.0 ; - 0.830223896278566929872032213967 ; - 0.468848793470714213803771881909 ;

 0.0 ; 0.468848793470714213803771881909 ; 0.830223896278566929872032213967 ; 1.0 |] ;;



let lobatto_7_w = [|  0.476190476190476190476190476190e-1 ; 0.276826047361565948010700406290 ; 0.431745381209862623417871022281 ;

 0.487619047619047619047619047619 ; 0.431745381209862623417871022281 ; 0.276826047361565948010700406290 ; 0.476190476190476190476190476190e-1 |] ;;





let lobatto_8_x = [|  - 1.0 ; - 0.871740148509606615337445761221 ; - 0.591700181433142302144510731398 ; - 0.209299217902478868768657260345 ;

 0.209299217902478868768657260345 ; 0.591700181433142302144510731398 ; 0.871740148509606615337445761221 ; 1.0 |] ;;



let lobatto_8_w = [|  0.357142857142857142857142857143e-1 ; 0.210704227143506039382991065776 ; 0.341122692483504364764240677108 ;

 0.412458794658703881567052971402 ; 0.412458794658703881567052971402 ; 0.341122692483504364764240677108 ; 0.210704227143506039382991065776 ;

 0.357142857142857142857142857143e-1 |] ;;





let lobatto_9_x = [|  - 1.0 ; - 0.899757995411460157312345244418 ; - 0.677186279510737753445885427091 ; - 0.363117463826178158710752068709 ; 0.0 ;

 0.363117463826178158710752068709 ; 0.677186279510737753445885427091 ; 0.899757995411460157312345244418 ; 1.0 |] ;;



let lobatto_9_w = [|  0.277777777777777777777777777778e-1 ; 0.165495361560805525046339720029 ; 0.274538712500161735280705618579 ;

 0.346428510973046345115131532140 ; 0.371519274376417233560090702948 ; 0.346428510973046345115131532140 ; 0.274538712500161735280705618579 ;

 0.165495361560805525046339720029 ; 0.277777777777777777777777777778e-1 |] ;;





let lobatto_9_x = [|  - 1.0 ; - 0.919533908166458813828932660822 ; - 0.738773865105505075003106174860 ; - 0.477924949810444495661175092731 ;

 - 0.165278957666387024626219765958 ; 0.165278957666387024626219765958 ; 0.477924949810444495661175092731 ; 0.738773865105505075003106174860 ;

 0.919533908166458813828932660822 ; 1.0 |] ;;



let lobatto_10_w = [|  0.222222222222222222222222222222e-1 ; 0.133305990851070111126227170755 ; 0.224889342063126452119457821731 ;

 0.292042683679683757875582257374 ; 0.327539761183897456656510527917 ; 0.327539761183897456656510527917 ; 0.292042683679683757875582257374 ;

 0.224889342063126452119457821731 ; 0.133305990851070111126227170755 ; 0.222222222222222222222222222222e-1 |] ;;





let lobatto_11_x = [|  - 1.0 ; - 0.934001430408059134332274136099 ; - 0.784483473663144418622417816108 ; - 0.565235326996205006470963969478 ;

 - 0.295758135586939391431911515559 ; 0.0 ; 0.295758135586939391431911515559 ; 0.565235326996205006470963969478 ;

 0.784483473663144418622417816108 ; 0.934001430408059134332274136099 ; 1.0 |] ;;



let lobatto_11_w = [|  0.181818181818181818181818181818e-1 ; 0.109612273266994864461403449580 ; 0.187169881780305204108141521899 ;

 0.248048104264028314040084866422 ; 0.286879124779008088679222403332 ; 0.300217595455690693785931881170 ; 0.286879124779008088679222403332 ;

 0.248048104264028314040084866422 ; 0.187169881780305204108141521899 ; 0.109612273266994864461403449580 ; 0.181818181818181818181818181818e-1 |] ;;





let lobatto_12_x = [|  - 1.0 ; - 0.944899272222882223407580138303 ; - 0.819279321644006678348641581717 ; - 0.632876153031869677662404854444 ;

 - 0.399530940965348932264349791567 ; - 0.136552932854927554864061855740 ; 0.136552932854927554864061855740 ; 0.399530940965348932264349791567 ;

 0.632876153031869677662404854444 ; 0.819279321644006678348641581717 ; 0.944899272222882223407580138303 ; 1.0 |] ;;



let lobatto_12_w = [|  0.151515151515151515151515151515e-1 ; 0.916845174131961306683425941341e-1 ; 0.157974705564370115164671062700 ;

 0.212508417761021145358302077367 ; 0.251275603199201280293244412148 ; 0.271405240910696177000288338500 ; 0.271405240910696177000288338500 ;

 0.251275603199201280293244412148 ; 0.212508417761021145358302077367 ; 0.157974705564370115164671062700 ; 0.916845174131961306683425941341e-1 ;

 0.151515151515151515151515151515e-1 |] ;;





let lobatto_13_x = [|  - 1.0 ; - 0.953309846642163911896905464755 ; - 0.846347564651872316865925607099 ; - 0.686188469081757426072759039566 ;

 - 0.482909821091336201746937233637 ; - 0.249286930106239992568673700374 ; 0.0 ; 0.249286930106239992568673700374 ; 0.482909821091336201746937233637 ;

 0.686188469081757426072759039566 ; 0.846347564651872316865925607099 ; 0.953309846642163911896905464755 ; 1.0 |] ;;



let lobatto_13_w = [|  0.128205128205128205128205128205e-1 ; 0.778016867468189277935889883331e-1 ; 0.134981926689608349119914762589 ;

 0.183646865203550092007494258747 ; 0.220767793566110086085534008379 ; 0.244015790306676356458578148360 ; 0.251930849333446736044138641541 ;

 0.244015790306676356458578148360 ; 0.220767793566110086085534008379 ; 0.183646865203550092007494258747 ; 0.134981926689608349119914762589 ;

 0.778016867468189277935889883331e-1 ; 0.128205128205128205128205128205e-1 |] ;;





let lobatto_14_x = [|  - 1.0 ; - 0.959935045267260901355100162015 ; - 0.867801053830347251000220202908 ; - 0.728868599091326140584672400521 ;

 - 0.550639402928647055316622705859 ; - 0.342724013342712845043903403642 ; - 0.116331868883703867658776709736 ; 0.116331868883703867658776709736 ;

 0.342724013342712845043903403642 ; 0.550639402928647055316622705859 ; 0.728868599091326140584672400521 ; 0.867801053830347251000220202908 ;

 0.959935045267260901355100162015 ; 1.0 |] ;;



let lobatto_14_w = [|  0.109890109890109890109890109890e-1 ; 0.668372844976812846340706607461e-1 ; 0.116586655898711651540996670655 ;

 0.160021851762952142412820997988 ; 0.194826149373416118640331778376 ; 0.219126253009770754871162523954 ; 0.231612794468457058889628357293 ;

 0.231612794468457058889628357293 ; 0.219126253009770754871162523954 ; 0.194826149373416118640331778376 ; 0.160021851762952142412820997988 ;

 0.116586655898711651540996670655 ; 0.668372844976812846340706607461e-1 ; 0.109890109890109890109890109890e-1 |] ;;





let lobatto_15_x = [|  - 1.0 ; - 0.965245926503838572795851392070 ; - 0.885082044222976298825401631482 ; - 0.763519689951815200704118475976 ;

 - 0.606253205469845711123529938637 ; - 0.420638054713672480921896938739 ; - 0.215353955363794238225679446273 ; 0.0 ;

 0.215353955363794238225679446273 ; 0.420638054713672480921896938739 ; 0.606253205469845711123529938637 ; 0.763519689951815200704118475976 ;

 0.885082044222976298825401631482 ; 0.965245926503838572795851392070 ; 1.0 |] ;;



let lobatto_15_w = [|  0.952380952380952380952380952381e-2 ; 0.580298930286012490968805840253e-1 ; 0.101660070325718067603666170789 ;

 0.140511699802428109460446805644 ; 0.172789647253600949052077099408 ; 0.196987235964613356092500346507 ; 0.211973585926820920127430076977 ;

 0.217048116348815649514950214251 ; 0.211973585926820920127430076977 ; 0.196987235964613356092500346507 ; 0.172789647253600949052077099408 ;

 0.140511699802428109460446805644 ; 0.101660070325718067603666170789 ; 0.580298930286012490968805840253e-1 ; 0.952380952380952380952380952381e-2 |] ;;





let lobatto_16_x = [|  - 1.0 ; - 0.969568046270217932952242738367 ; - 0.899200533093472092994628261520 ; - 0.792008291861815063931088270963 ;

 - 0.652388702882493089467883219641 ; - 0.486059421887137611781890785847 ; - 0.299830468900763208098353454722 ; - 0.101326273521949447843033005046 ;

 0.101326273521949447843033005046 ; 0.299830468900763208098353454722 ; 0.486059421887137611781890785847 ; 0.652388702882493089467883219641 ;

 0.792008291861815063931088270963 ; 0.899200533093472092994628261520 ; 0.969568046270217932952242738367 ; 1.0 |] ;;



let lobatto_16_w = [|  0.833333333333333333333333333333e-2 ; 0.508503610059199054032449195655e-1 ; 0.893936973259308009910520801661e-1 ;

 0.124255382132514098349536332657 ; 0.154026980807164280815644940485 ; 0.177491913391704125301075669528 ; 0.193690023825203584316913598854 ;

 0.201958308178229871489199125411 ; 0.201958308178229871489199125411 ; 0.193690023825203584316913598854 ; 0.177491913391704125301075669528 ;

 0.154026980807164280815644940485 ; 0.124255382132514098349536332657 ; 0.893936973259308009910520801661e-1 ; 0.508503610059199054032449195655e-1 ;

 0.833333333333333333333333333333e-2 |] ;;





let lobatto_17_x = [|  - 1.0 ; - 0.973132176631418314156979501874 ; - 0.910879995915573595623802506398 ; - 0.815696251221770307106750553238 ;

 - 0.691028980627684705394919357372 ; - 0.541385399330101539123733407504 ; - 0.372174433565477041907234680735 ; - 0.189511973518317388304263014753 ;

 0.0 ; 0.189511973518317388304263014753 ; 0.372174433565477041907234680735 ; 0.541385399330101539123733407504 ; 0.691028980627684705394919357372 ;

 0.815696251221770307106750553238 ; 0.910879995915573595623802506398 ; 0.973132176631418314156979501874 ; 1.0 |] ;;



let lobatto_17_w = [|  0.735294117647058823529411764706e-2 ; 0.449219405432542096474009546232e-1 ; 0.791982705036871191902644299528e-1 ;

 0.110592909007028161375772705220 ; 0.137987746201926559056201574954 ; 0.160394661997621539516328365865 ; 0.177004253515657870436945745363 ;

 0.187216339677619235892088482861 ; 0.190661874753469433299407247028 ; 0.187216339677619235892088482861 ; 0.177004253515657870436945745363 ;

 0.160394661997621539516328365865 ; 0.137987746201926559056201574954 ; 0.110592909007028161375772705220 ; 0.791982705036871191902644299528e-1 ;

 0.449219405432542096474009546232e-1 ; 0.735294117647058823529411764706e-2 |] ;;





let lobatto_18_x = [|  - 1.0 ; - 0.976105557412198542864518924342 ; - 0.920649185347533873837854625431 ; - 0.835593535218090213713646362328 ;

 - 0.723679329283242681306210365302 ; - 0.588504834318661761173535893194 ; - 0.434415036912123975342287136741 ; - 0.266362652878280984167665332026 ;

 - 0.897490934846521110226450100886e-1 ; 0.897490934846521110226450100886e-1 ; 0.266362652878280984167665332026 ; 0.434415036912123975342287136741 ;

 0.588504834318661761173535893194 ; 0.723679329283242681306210365302 ; 0.835593535218090213713646362328 ; 0.920649185347533873837854625431 ;

 0.976105557412198542864518924342 ; 1.0 |] ;;



let lobatto_18_w = [|  0.653594771241830065359477124183e-2 ; 0.399706288109140661375991764101e-1 ; 0.706371668856336649992229601678e-1 ;

 0.990162717175028023944236053187e-1 ; 0.124210533132967100263396358897 ; 0.145411961573802267983003210494 ; 0.161939517237602489264326706700 ;

 0.173262109489456226010614403827 ; 0.179015863439703082293818806944 ; 0.179015863439703082293818806944 ; 0.173262109489456226010614403827 ;

 0.161939517237602489264326706700 ; 0.145411961573802267983003210494 ; 0.124210533132967100263396358897 ; 0.990162717175028023944236053187e-1 ;

 0.706371668856336649992229601678e-1 ; 0.399706288109140661375991764101e-1 ; 0.653594771241830065359477124183e-2 |] ;;





let lobatto_19_x = [|  - 1.0 ; - 0.978611766222080095152634063110 ; - 0.928901528152586243717940258797 ; - 0.852460577796646093085955970041 ;

 - 0.751494202552613014163637489634 ; - 0.628908137265220497766832306229 ; - 0.488229285680713502777909637625 ; - 0.333504847824498610298500103845 ;

 - 0.169186023409281571375154153445 ; 0.0 ; 0.169186023409281571375154153445 ; 0.333504847824498610298500103845 ; 0.488229285680713502777909637625 ;

 0.628908137265220497766832306229 ; 0.751494202552613014163637489634 ; 0.852460577796646093085955970041 ; 0.928901528152586243717940258797 ;

 0.978611766222080095152634063110 ; 1.0 |] ;;



let lobatto_19_w = [|  0.584795321637426900584795321637e-2 ; 0.357933651861764771154255690351e-1 ; 0.633818917626297368516956904183e-1 ;

 0.891317570992070844480087905562e-1 ; 0.112315341477305044070910015464 ; 0.132267280448750776926046733910 ; 0.148413942595938885009680643668 ;

 0.160290924044061241979910968184 ; 0.167556584527142867270137277740 ; 0.170001919284827234644672715617 ; 0.167556584527142867270137277740 ;

 0.160290924044061241979910968184 ; 0.148413942595938885009680643668 ; 0.132267280448750776926046733910 ; 0.112315341477305044070910015464 ;

 0.891317570992070844480087905562e-1 ; 0.633818917626297368516956904183e-1 ; 0.357933651861764771154255690351e-1 ; 0.584795321637426900584795321637e-2 |] ;;





let lobatto_20_x = [| - 1.0 ; - 0.980743704893914171925446438584 ; - 0.935934498812665435716181584931 ; - 0.866877978089950141309847214616 ;

 - 0.775368260952055870414317527595 ; - 0.663776402290311289846403322971 ; - 0.534992864031886261648135961829 ; - 0.392353183713909299386474703816 ;

 - 0.239551705922986495182401356927 ; - 0.805459372388218379759445181596e-1 ; 0.805459372388218379759445181596e-1 ; 0.239551705922986495182401356927 ;

 0.392353183713909299386474703816 ; 0.534992864031886261648135961829 ; 0.663776402290311289846403322971 ; 0.775368260952055870414317527595 ;

 0.866877978089950141309847214616 ; 0.935934498812665435716181584931 ; 0.980743704893914171925446438584 ; 1.0 |] ;;



let lobatto_20_w = [|  0.526315789473684210526315789474e-2 ; 0.322371231884889414916050281173e-1 ; 0.571818021275668260047536271732e-1 ;

 0.806317639961196031447768461137e-1 ; 0.101991499699450815683781205733 ; 0.120709227628674725099429705002 ; 0.136300482358724184489780792989 ;

 0.148361554070916825814713013734 ; 0.156580102647475487158169896794 ; 0.160743286387845749007726726449 ; 0.160743286387845749007726726449 ;

 0.156580102647475487158169896794 ; 0.148361554070916825814713013734 ; 0.136300482358724184489780792989 ; 0.120709227628674725099429705002 ;

 0.101991499699450815683781205733 ; 0.806317639961196031447768461137e-1 ; 0.571818021275668260047536271732e-1 ; 0.322371231884889414916050281173e-1 ;

 0.526315789473684210526315789474e-2 |] ;;





let newton_cotes_1_x = [| 0. |] ;;



let newton_cotes_1_w = [| 2. |] ;;





let newton_cotes_2_w = [| 1. ; 1. |] ;;



let newton_cotes_2_x = [| -1. ; 1. |] ;;





let newton_cotes_3_w = [| 1. /. 3. ; 4. /. 3. ; 1. /. 3. |] ;;



let newton_cotes_3_x = [| -1. ; 0. ; 1.0 |] ;;





let newton_cotes_4_w = [| 1. /. 4. ; 3. /. 4. ; 3. /. 4. ; 1. /. 4. |] ;;



let newton_cotes_4_x = [| -1. ; -0.33333333333333333333 ; 0.33333333333333333333 ; 1.0 |] ;;





let newton_cotes_5_w = [| 7. /. 45. ; 32. /. 45. ; 12. /. 45. ; 32. /. 45. ; 7. /. 45. |] ;;



let newton_cotes_5_x = [| -1. ; -0.5 ; 0. ; 0.5 ; 1.0 |] ;;





let newton_cotes_6_w = [| 19. /. 144. ; 75. /. 144. ; 50. /. 144. ; 50. /. 144. ; 75. /. 144. ; 19. /. 144. |] ;;



let newton_cotes_6_x = [| -1. ; -0.6 ; -0.2 ; 0.2 ; 0.6 ; 1.0 |] ;;





let newton_cotes_7_w = [| 41. /. 420. ; 216. /. 420. ; 27. /. 420. ; 272. /. 420. ; 27. /. 420. ; 216. /. 420. ; 41. /. 420. |] ;;



let newton_cotes_7_x = [| -1. ; -0.66666666666666666667 ; -0.33333333333333333333 ; 0. ; 0.33333333333333333333 ; 0.66666666666666666667 ; 1.0 |] ;;





let newton_cotes_8_w = [| 751. /. 8640. ; 3577. /. 8640. ; 1323. /. 8640. ; 2989. /. 8640. ; 2989. /. 8640. ;

 1323. /. 8640. ; 3577. /. 8640. ; 751. /. 8640. |] ;;



let newton_cotes_8_x = [| -1. ; -0.71428571428571428571 ; -0.42857142857142857143 ; -0.14285714285714285714 ;

 0.14285714285714285714 ; 0.42857142857142857143 ; 0.71428571428571428571 ; 1.0 |] ;;





let newton_cotes_9_w = [| 989. /. 14175. ; 5888. /. 14175. ; -928. /. 14175. ; 10496. /. 14175. ; -4540. /. 14175. ;

 10496. /. 14175. ; -928. /. 14175. ; 5888. /. 14175. ; 989. /. 14175. |] ;;



let newton_cotes_9_x = [| -1. ; -0.75 ; -0.5 ; -0.25 ; 0. ; 0.25 ; 0.5 ; 0.75 ; 1.0 |] ;;





let newton_cotes_10_w = [| 2857. /. 44800. ; 15741. /. 44800. ; 1080. /. 44800. ; 19344. /. 44800. ; 5778. /. 44800. ;

 5778. /. 44800. ; 19344. /. 44800. ; 1080. /. 44800. ; 15741. /. 44800. ; 2857. /. 44800. |] ;;



let newton_cotes_10_x = [| -1. ; -0.77777777777777777778 ; -0.55555555555555555556 ; -0.33333333333333333333 ; -0.11111111111111111111 ;

 0.11111111111111111111 ; 0.33333333333333333333 ; 0.55555555555555555556 ; 0.77777777777777777778 ; 1.0 |] ;;





let newton_cotes_11_w = [| 16067. /. 299376. ; 106300. /. 299376. ; - 48525. /. 299376. ; 272400. /. 299376. ; - 260550. /. 299376. ;

 427368. /. 299376. ; - 260550. /. 299376. ; 272400. /. 299376. ; - 48525. /. 299376. ; 106300. /. 299376. ; 16067. /. 299376. |] ;;



let newton_cotes_11_x = [| -1. ; -0.8 ; -0.6 ; -0.4 ; -0.2 ; 0. ; 0.2 ; 0.4 ; 0.6 ; 0.8 ; 1.0 |] ;;





let newton_cotes_12_w = [| 2171465. /. 43545600. ; 13486539. /. 43545600. ; - 3237113. /. 43545600. ; 25226685. /. 43545600. ;

 - 9595542. /. 43545600. ; 15493566. /. 43545600. ; 15493566. /. 43545600. ; - 9595542. /. 43545600. ; 25226685. /. 43545600. ;

 - 3237113. /. 43545600. ; 13486539. /. 43545600. ; 2171465. /. 43545600. |] ;;



let newton_cotes_12_x = [| -1. ; -0.81818181818181818182 ; -0.63636363636363636364 ; -0.45454545454545454545 ; -0.27272727272727272727 ;

 -0.090909090909090909091 ; 0.090909090909090909091 ; 0.27272727272727272727 ; 0.45454545454545454545 ; 0.63636363636363636364 ; 0.81818181818181818182 ; 1.0 |] ;;





let newton_cotes_13_w = [| 1364651. /. 31531500. ; 9903168. /. 31531500. ; - 7587864. /. 31531500. ; 35725120. /. 31531500. ;

 - 51491295. /. 31531500. ; 87516288. /. 31531500. ; - 87797136. /. 31531500. ; 87516288. /. 31531500. ; - 51491295. /. 31531500. ;

 35725120. /. 31531500. ; - 7587864. /. 31531500. ; 9903168. /. 31531500. ; 1364651. /. 31531500. |] ;;



let newton_cotes_13_x = [| -1. ; -0.83333333333333333333 ; -0.66666666666666666667 ; -0.5 ; -0.33333333333333333333 ; -0.16666666666666666667 ;

 0. ; 0.16666666666666666667 ; 0.33333333333333333333 ; 0.5 ; 0.66666666666666666667 ; 0.83333333333333333333 ; 1.0 |] ;;





let newton_cotes_14_w = [| 6137698213. /. 150885504000. ; 42194238652. /. 150885504000. ; - 23361540993. /. 150885504000. ;

 116778274403. /. 150885504000. ; - 113219777650. /. 150885504000. ; 154424590209. /. 150885504000. ; - 32067978834. /. 150885504000. ;

 - 32067978834. /. 150885504000. ; 154424590209. /. 150885504000. ; - 113219777650. /. 150885504000. ; 116778274403. /. 150885504000. ;

 - 23361540993. /. 150885504000. ; 42194238652. /. 150885504000. ; 6137698213. /. 150885504000. |] ;;



let newton_cotes_14_x = [| -1. ; -0.84615384615384615385 ; -0.69230769230769230769 ; -0.53846153846153846154 ; -0.38461538461538461538 ;

 -0.23076923076923076923 ; -0.076923076923076923077 ; 0.076923076923076923077 ; 0.23076923076923076923 ; 0.38461538461538461538 ;

 0.53846153846153846154 ; 0.69230769230769230769 ; 0.84615384615384615385 ; 1.0 |] ;;





let newton_cotes_15_w = [| 90241897. /. 2501928000. ; 710986864. /. 2501928000. ; - 770720657. /. 2501928000. ; 3501442784. /. 2501928000. ;

 - 6625093363. /. 2501928000. ; 12630121616. /. 2501928000. ; - 16802270373. /. 2501928000. ; 19534438464. /. 2501928000. ;

 - 16802270373. /. 2501928000. ; 12630121616. /. 2501928000. ; - 6625093363. /. 2501928000. ; 3501442784. /. 2501928000. ;

 - 770720657. /. 2501928000. ; 710986864. /. 2501928000. ; 90241897. /. 2501928000. |] ;;



let newton_cotes_15_x = [| -1. ; -0.85714285714285714286 ; -0.71428571428571428571 ; -0.57142857142857142857 ; -0.42857142857142857143 ;

 -0.28571428571428571429 ; -0.14285714285714285714 ; 0. ; 0.14285714285714285714 ; 0.28571428571428571429 ;

 0.42857142857142857143 ; 0.57142857142857142857 ; 0.71428571428571428571 ; 0.85714285714285714286 ; 1.0 |] ;;





let newton_cotes_16_w = [| 105930069. /. 3099672576. ; 796661595. /. 3099672576. ; - 698808195. /. 3099672576. ;

 3143332755. /. 3099672576. ; - 4688522055. /. 3099672576. ; 7385654007. /. 3099672576. ; - 6000998415. /. 3099672576. ;

 3056422815. /. 3099672576. ; 3056422815. /. 3099672576. ; - 6000998415. /. 3099672576. ; 7385654007. /. 3099672576. ;

 - 4688522055. /. 3099672576. ; 3143332755. /. 3099672576. ; - 698808195. /. 3099672576. ; 796661595. /. 3099672576. ; 105930069. /. 3099672576. |] ;;



let newton_cotes_16_x = [| -1. ; -0.86666666666666666667 ; -0.73333333333333333333 ; -0.6 ; -0.46666666666666666667 ; -0.33333333333333333333 ; -0.2 ;

 -0.066666666666666666667 ; 0.066666666666666666667 ; 0.2 ; 0.33333333333333333333 ; 0.46666666666666666667 ; 0.6 ; 0.73333333333333333333 ;

 0.86666666666666666667 ; 1.0 |] ;;





let newton_cotes_17_w = [| 15043611773. /. 488462349375. ; 127626606592. /. 488462349375. ; - 179731134720. /. 488462349375. ;

 832211855360. /. 488462349375. ; - 1929498607520. /. 488462349375. ; 4177588893696. /. 488462349375. ; - 6806534407936. /. 488462349375. ;

 9368875018240. /. 488462349375. ; - 10234238972220. /. 488462349375. ; 9368875018240. /. 488462349375. ; - 6806534407936. /. 488462349375. ;

 4177588893696. /. 488462349375. ; - 1929498607520. /. 488462349375. ; 832211855360. /. 488462349375. ;

 - 179731134720. /. 488462349375. ; 127626606592. /. 488462349375. ; 15043611773. /. 488462349375. |] ;;



let newton_cotes_17_x = [| -1. ; -0.875 ; -0.75 ; -0.625 ; -0.5 ; -0.375 ; -0.25 ; -0.125 ; 0. ; 0.125 ; 0.25 ; 0.375 ; 0.5 ; 0.625 ; 0.75 ; 0.875 ; 1.0 |] ;;





let newton_cotes_18_w = [| 55294720874657. /. 1883051089920000. ; 450185515446285. /. 1883051089920000. ; - 542023437008852. /. 1883051089920000. ; 2428636525764260. /. 1883051089920000. ;

 - 4768916800123440. /. 1883051089920000. ; 8855416648684984. /. 1883051089920000. ; - 10905371859796660. /. 1883051089920000. ; 10069615750132836. /. 1883051089920000. ;

 - 3759785974054070. /. 1883051089920000. ; - 3759785974054070. /. 1883051089920000. ; 10069615750132836. /. 1883051089920000. ; - 10905371859796660. /. 1883051089920000. ;

 8855416648684984. /. 1883051089920000. ; - 4768916800123440. /. 1883051089920000. ; 2428636525764260. /. 1883051089920000. ; - 542023437008852. /. 1883051089920000. ;

 450185515446285. /. 1883051089920000. ; 55294720874657. /. 1883051089920000. |] ;;



let newton_cotes_18_x = [| -1. ; -0.88235294117647058824 ; -0.76470588235294117647 ; -0.64705882352941176471 ; -0.52941176470588235294 ;

 -0.41176470588235294118 ; -0.29411764705882352941 ; -0.17647058823529411765 ; -0.058823529411764705882 ; 0.058823529411764705882 ;

 0.17647058823529411765 ; 0.29411764705882352941 ; 0.41176470588235294118 ; 0.52941176470588235294 ; 0.64705882352941176471 ;

 0.76470588235294117647 ; 0.88235294117647058824 ; 1.0 |] ;;





let newton_cotes_19_w = [| 203732352169. /. 7604556960000. ; 1848730221900. /. 7604556960000. ; - 3212744374395. /. 7604556960000. ; 15529830312096. /. 7604556960000. ;

 - 42368630685840. /. 7604556960000. ; 103680563465808. /. 7604556960000. ; - 198648429867720. /. 7604556960000. ; 319035784479840. /. 7604556960000. ;

 - 419127951114198. /. 7604556960000. ; 461327344340680. /. 7604556960000. ; - 419127951114198. /. 7604556960000. ; 319035784479840. /. 7604556960000. ;

 - 198648429867720. /. 7604556960000. ; 103680563465808. /. 7604556960000. ; - 42368630685840. /. 7604556960000. ; 15529830312096. /. 7604556960000. ;

 - 3212744374395. /. 7604556960000. ; 1848730221900. /. 7604556960000. ; 203732352169. /. 7604556960000. |] ;;



let newton_cotes_19_x = [| -1. ; -0.88888888888888888889 ; -0.77777777777777777778 ; -0.66666666666666666667 ; -0.55555555555555555556 ;

 -0.44444444444444444444 ; -0.33333333333333333333 ; -0.22222222222222222222 ; -0.11111111111111111111 ; 0. ; 0.11111111111111111111 ;

 0.22222222222222222222 ; 0.33333333333333333333 ; 0.44444444444444444444 ; 0.55555555555555555556 ; 0.66666666666666666667 ;

 0.77777777777777777778 ; 0.88888888888888888889 ; 1. |] ;;





let newton_cotes_20_w = [| 69028763155644023. /. 2688996956405760000. ; 603652082270808125. /. 2688996956405760000. ; - 926840515700222955. /. 2688996956405760000. ;

 4301581538450500095. /. 2688996956405760000. ; - 10343692234243192788. /. 2688996956405760000. ; 22336420328479961316. /. 2688996956405760000. ;

 - 35331888421114781580. /. 2688996956405760000. ; 43920768370565135580. /. 2688996956405760000. ; - 37088370261379851390. /. 2688996956405760000. ;

 15148337305921759574. /. 2688996956405760000. ; 15148337305921759574. /. 2688996956405760000. ; - 37088370261379851390. /. 2688996956405760000. ;

 43920768370565135580. /. 2688996956405760000. ; - 35331888421114781580. /. 2688996956405760000. ; 22336420328479961316. /. 2688996956405760000. ;

 - 10343692234243192788. /. 2688996956405760000. ; 4301581538450500095. /. 2688996956405760000. ; - 926840515700222955. /. 2688996956405760000. ;

 603652082270808125. /. 2688996956405760000. ; 69028763155644023. /. 2688996956405760000. |] ;;



let newton_cotes_20_x = [| -1. ; -0.89473684210526315789 ; -0.78947368421052631579 ; -0.68421052631578947368 ;

 -0.57894736842105263158 ; -0.47368421052631578947 ; -0.36842105263157894737 ; -0.26315789473684210526 ;

 -0.15789473684210526316 ; -0.052631578947368421053 ; 0.052631578947368421053 ; 0.15789473684210526316 ;

 0.26315789473684210526 ; 0.36842105263157894737 ; 0.47368421052631578947 ; 0.57894736842105263158 ;

 0.68421052631578947368 ; 0.78947368421052631579 ; 0.89473684210526315789 ; 1.0 |] ;;





let newton_cotes_21_x = [| -1. ; -0.9 ; -0.8 ; -0.7 ; -0.6 ; -0.5 ; -0.4 ; -0.3 ; -0.2 ; -0.1 ; 0. ; 0.1 ; 0.2 ; 0.3 ; 0.4 ; 0.5 ; 0.6 ; 0.7 ; 0.8 ; 0.9 ; 1. |] ;;



let newton_cotes_21_w = [| 0.023650546498063206389 ; 0.22827543528921394997 ; -0.47295674102285392846 ; 2.4123737869637513288 ;

 -7.5420634534306609355 ; 20.673596439879602287 ; -45.417631687959024596 ; 83.656114844387109207 ; -128.1505589803080093 ;

 165.59456694494570344 ; -180.01073427048578932 ; 165.59456694494570344 ; -128.1505589803080093 ; 83.656114844387109207 ;

 -45.417631687959024596 ; 20.673596439879602287 ; -7.5420634534306609355 ; 2.4123737869637513288 ; -0.47295674102285392846 ;

 0.22827543528921394997 ; 0.023650546498063206389 |] ;;





let radau_1_x = [|  - 1.0 |] ;;



let radau_1_w = [|  2.0 |] ;;





let radau_2_x = [| - 1.0 ;

 1.0 /. 3.0 |] ;;



let radau_2_w = [| 0.5 ;

 1.5 |] ;;





let radau_3_x = [|  - 1.0 ; - 0.289897948556635619639456814941 ; 0.689897948556635619639456814941 |] ;;



let radau_3_w = [| 0.222222222222222222222222222222 ; 1.02497165237684322767762689304 ; 0.752806125400934550100150884739 |] ;;





let radau_4_x = [| - 1.0 ; - 0.575318923521694112050483779752 ; 0.181066271118530578270147495862 ; 0.822824080974592105208907712461 |] ;;



let radau_4_w = [| 0.125 ; 0.657688639960119487888578442146 ; 0.776386937686343761560464613780 ; 0.440924422353536750550956944074 |] ;;





let radau_5_x = [| - 1.0 ; - 0.720480271312438895695825837750 ; - 0.167180864737833640113395337326 ; 0.446313972723752344639908004629 ; 0.885791607770964635613757614892 |] ;;



let radau_5_w = [| 0.08 ; 0.446207802167141488805120436457 ; 0.623653045951482508163709823153 ; 0.562712030298924120384345300681 ; 0.287427121582451882646824439708 |] ;;





let radau_6_x = [| - 1.0 ; - 0.802929828402347147753002204224 ; - 0.390928546707272189029229647442 ; 0.124050379505227711989974959990 ; 0.603973164252783654928415726409 ;

 0.920380285897062515318386619813 |] ;;



let radau_6_w = [| 0.555555555555555555555555555556e-1 ; 0.319640753220510966545779983796 ; 0.485387188468969916159827915587 ; 0.520926783189574982570229406570 ;

 0.416901334311907738959406382743 ; 0.201588385253480840209200755749 |] ;;





let radau_7_x = [| - 1.0 ; - 0.853891342639482229703747931639 ; - 0.538467724060109001833766720231 ; - 0.117343037543100264162786683611 ; 0.326030619437691401805894055838 ;

 0.703842800663031416300046295008 ; 0.941367145680430216055899446174 |] ;;



let radau_7_w = [| 0.408163265306122448979591836735e-1 ; 0.239227489225312405787077480770 ; 0.380949873644231153805938347876 ; 0.447109829014566469499348953642 ;

 0.424703779005955608398308039150 ; 0.318204231467301481744870434470 ; 0.148988471112020635866497560418 |] ;;





let radau_8_x = [| - 1.0 ; - 0.887474878926155707068695617935 ; - 0.639518616526215270024840114382 ; - 0.294750565773660725252184459658 ; 0.943072526611107660028971153047e-1 ;

 0.468420354430821063046421216613 ; 0.770641893678191536180719525865 ; 0.955041227122575003782349000858 |] ;;



let radau_8_w = [| 0.03125 ; 0.185358154802979278540728972699 ; 0.304130620646785128975743291400 ; 0.376517545389118556572129261442 ; 0.391572167452493593082499534004 ;

 0.347014795634501280228675918422 ; 0.249647901329864963257869293513 ; 0.114508814744257199342353728520 |] ;;





let radau_9_x = [| - 1.0 ; - 0.910732089420060298533757956283 ; - 0.711267485915708857029562959544 ; - 0.426350485711138962102627520502 ; - 0.903733696068532980645444599064e-1 ;

 0.256135670833455395138292079035 ; 0.571383041208738483284917464837 ; 0.817352784200412087992517083851 ; 0.964440169705273096373589797925 |] ;;



let radau_9_w = [| 0.246913580246913580246913580247e-1 ; 0.147654019046315385819588499802 ; 0.247189378204593052361239794969 ; 0.316843775670437978338000849642 ;

 0.348273002772966594071991031186 ; 0.337693966975929585803724239792 ; 0.286386696357231171146705637752 ; 0.200553298024551957421165090417 ; 0.907145049232829170128934984159e-1 |] ;;





let radau_10_x = [| - 1.0 ; - 0.927484374233581078117671398464 ; - 0.763842042420002599615429776011 ; - 0.525646030370079229365386614293 ; - 0.236234469390588049278459503207 ;

 0.760591978379781302337137826389e-1 ; 0.380664840144724365880759065541 ; 0.647766687674009436273648507855 ; 0.851225220581607910728163628088 ; 0.971175180702246902734346518378 |] ;;



let radau_10_w = [| 0.02 ; 0.120296670557481631517310522702 ; 0.204270131879000675555788672223 ; 0.268194837841178696058554475262 ; 0.305859287724422621016275475401 ;

 0.313582457226938376695902847302 ; 0.290610164832918311146863077963 ; 0.239193431714379713376571966160 ; 0.164376012736921475701681668908 ; 0.736170054867584989310512940790e-1 |] ;;





let radau_11_x = [| - 1.0 ; - 0.939941935677027005913871284731 ; - 0.803421975580293540697597956820 ; - 0.601957842073797690275892603234 ; - 0.351888923353330214714301017870 ;

 - 0.734775314313212657461903554238e-1 ; 0.210720306228426314076095789845 ; 0.477680647983087519467896683890 ; 0.705777100713859519144801128840 ; 0.876535856245703748954741265611 ;

 0.976164773135168806180508826082 |] ;;



let radau_11_w = [| 0.165289256198347107438016528926e-1 ; 0.998460819079680638957534695802e-1 ; 0.171317619206659836486712649042 ; 0.228866123848976624401683231126 ;

 0.267867086189684177806638163355 ; 0.285165563941007337460004408915 ; 0.279361333103383045188962195720 ; 0.250925377697128394649140267633 ; 0.202163108540024418349931754266 ;

 0.137033682133202256310153880580 ; 0.609250978121311347072183268883e-1 |] ;;





let radau_12_x = [| - 1.0 ; - 0.949452759204959300493337627077 ; - 0.833916773105189706586269254036 ; - 0.661649799245637148061133087811 ; - 0.444406569781935851126642615609 ;

 - 0.196994559534278366455441427346 ; 0.637247738208319158337792384845e-1 ; 0.319983684170669623532789532206 ; 0.554318785912324288984337093085 ; 0.750761549711113852529400825472 ;

 0.895929097745638894832914608454 ; 0.979963439076639188313950540264 |] ;;



let radau_12_w = [| 0.138888888888888888888888888888e-1 ; 0.841721349386809762415796536813e-1 ; 0.145563668853995128522547654706 ; 0.196998534826089634656049637969 ;

 0.235003115144985839348633985940 ; 0.256991338152707776127974253598 ; 0.261465660552133103438074715743 ; 0.248121560804009959403073107079 ; 0.217868879026192438848747482023 ;

 0.172770639313308564306065766966 ; 0.115907480291738392750341908272 ; 0.512480992072692974680229451351e-1 |] ;;





let radau_13_x = [| - 1.0 ; - 0.956875873668299278183813833834 ; - 0.857884202528822035697620310269 ; - 0.709105087529871761580423832811 ; - 0.519197779050454107485205148087 ;

 - 0.299201300554509985532583446686 ; - 0.619016986256353412578604857936e-1 ; 0.178909837597084635021931298881 ; 0.409238231474839556754166331248 ; 0.615697890940291918017885487543 ;

 0.786291018233046684731786459135 ; 0.911107073689184553949066402429 ; 0.982921890023145161262671078244 |] ;;



let radau_13_w = [| 0.118343195266272189349112426036e-1 ; 0.719024162924955289397537405641e-1 ; 0.125103834331152358133769287976 ; 0.171003460470616642463758674512 ;

 0.206960611455877074631132560829 ; 0.230888862886995434012203758668 ; 0.241398342287691148630866924129 ; 0.237878547660712031342685189180 ; 0.220534229288451464691077164199 ;

 0.190373715559631732254759820746 ; 0.149150950090000205151491864242 ; 0.992678068818470859847363877478e-1 ; 0.437029032679020748288533846051e-1 |] ;;





let radau_14_x = [| - 1.0 ; - 0.962779269978024297120561244319 ; - 0.877048918201462024795266773531 ; - 0.747389642613378838735429134263 ; - 0.580314056546874971105726664999 ;

 - 0.384202003439203313794083903375 ; - 0.168887928042680911008441695622 ; 0.548312279917645496498107146428e-1 ; 0.275737205435522399182637403545 ; 0.482752918588474966820418534355 ;

 0.665497977216884537008955042481 ; 0.814809550601994729434217249123 ; 0.923203722520643299246334950272 ; 0.985270697947821356698617003172 |] ;;



let radau_14_w = [| 0.102040816326530612244897959184e-1 ; 0.621220169077714601661329164668e-1 ; 0.108607722744362826826720935229 ; 0.149620539353121355950520836946 ;

 0.183127002125729654123867302103 ; 0.207449763335175672668082886489 ; 0.221369811499570948931671683021 ; 0.224189348002707794238414632220 ; 0.215767100604618851381187446115 ;

 0.196525518452982430324613091930 ; 0.167429727891086278990102277038 ; 0.129939668737342347807425737146 ; 0.859405354429804030893077310866e-1 ; 0.377071632698969142774627282919e-1 |] ;;





let radau_15_x = [| - 1.0 ; - 0.967550468197200476562456018282 ; - 0.892605400120550767066811886849 ; - 0.778685617639031079381743321893 ; - 0.630779478886949283946148437224 ;

 - 0.455352905778529370872053455981 ; - 0.260073376740807915768961188263 ; - 0.534757226797460641074538896258e-1 ; 0.155410685384859484319182024964 ; 0.357456512022127651195319205174 ;

 0.543831458701484016930711802760 ; 0.706390264637572540152679669478 ; 0.838029000636089631215097384520 ; 0.932997190935973719928072142859 ; 0.987166478414363086378359071811 |] ;;



let radau_15_w = [| 0.888888888888888888888888888889e-2 ; 0.542027800486444943382142368018e-1 ; 0.951295994604808992038477266346e-1 ; 0.131875462504951632186262157944 ;

 0.162854477303832629448732245828 ; 0.186715145839450908083795103799 ; 0.202415187030618429872703310435 ; 0.209268608147694581430889790306 ; 0.206975960249553755479027321787 ;

 0.195637503045116116473556617575 ; 0.175748872642447685670310440476 ; 0.148179527003467253924682058743 ; 0.114135203489752753013075582569 ; 0.751083927605064397329716653914e-1 ;

 0.328643915845935322530428528231e-1 |] ;;










(** 
 
 *)









(** 
float_weighted_int_minus1_1 abscissae weights function a b
 The standard abscissae are spread over the interval -1 ; 1.
The ends of the integration interval must be filled in.



Les abscisses normalisées sont réparties sur l'interavlle -1 ; 1.
Les bornes d'intégration doivent être précisées. *)


let float_weighted_int_minus1_1 = fun (x:float array) (w:float array) (f:float -> float) (a:float) (b:float) ->

 let l = Array.length x

 and accu = ref 0.

 and center = ( a +. b ) /. 2.

 and halflength = ( b -. a ) /. 2. in

  for i = 0 to l - 1 do

   accu := !accu +. w.(i) *. f ( center +. halflength *. x.(i) ) ;

  done ;

  !accu *. halflength ;;










(** 
§ 
 *)



(** 

Méthodes adaptatives variées


Miscellaneous adaptative methods

*)



(** 
 
 *)











(** 
float_int_dichot_adapt methode tolerance function a b
 The method must contain the integrating method, included
the parameters, as in the following example. 
The tolerance is the relative error allowed between two steps in order to stop the dichotomy.




float_int_romberg 11 4




La méthode doit contenir la méthode d'intégration, y compris les paramètres, 
comme dans l'exemple ci-dessus. La tolérance est l'erreur relative admise entre deux pas pour arrêter la dichotomie.
*)


let rec float_int_dichot_adapt = fun methode (tol:float) (f:float -> float) (a:float) (b:float) ->

 let first = methode f a b

 and c = ( a +. b ) *. 0.5 in

  let second = ref ( methode f a c +. methode f c b ) in

   if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

    begin

     second := float_int_dichot_adapt methode tol f a c +. float_int_dichot_adapt methode tol f c b

    end ;

   !second ;;




(** 
float_int_dichot_bounded maxstages methode tolerance function a b
 The method must contain the integrating method, included
the parameters, as in the following example. 
The tolerance is the relative error allowed between two steps in order to stop the dichotomy.




float_int_romberg 11 4




La méthode doit contenir la méthode d'intégration, y compris les paramètres, 
comme dans l'exemple ci-dessus. La tolérance est l'erreur relative admise entre deux pas pour arrêter la dichotomie.
*)


let rec float_int_dichot_bounded = fun (maxstages:int) methode (tol:float) (f:float -> float) (a:float) (b:float) ->

 match maxstages with 

 | 0 -> methode f a b

 | _ -> 

  let first = methode f a b

  and c = ( a +. b ) *. 0.5 in

   let second = ref ( methode f a c +. methode f c b ) in

    if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

     begin

      second := float_int_dichot_bounded ( ( abs maxstages ) - 1 ) methode tol f a c

       +. float_int_dichot_bounded ( ( abs maxstages ) - 1 ) methode tol f c b

     end ;

    !second ;;






(** 
float_int_multi_adapt methode nslices tolerance function a b
 The method must contain the integrating method, included
the parameters, as in the following example. 
The tolerance is the relative error allowed between two steps in order to stop the slicing.




float_int_romberg 11 4




La méthode doit contenir la méthode d'intégration, y compris les paramètres, 
comme dans l'exemple ci-dessus. La tolérance est l'erreur relative admise entre deux pas pour arrêter le tranchage.
*)


let rec float_int_multi_adapt = fun methode (nslices:int) (tol:float) (f:float -> float) (a:float) (b:float) ->

 let first = methode f a b

 and length = ( b -. a ) /. ( float nslices ) in

  let c = ref ( a +. length )

  and d = ref 0. in

   let second = ref ( methode f a !c ) in

   for i = 2 to nslices do

    d := !c +. length ;

    second := !second +. methode f !c !d ;

    c := !d ;

   done ;

   if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

    begin

     c := a +. length ;

     second := float_int_multi_adapt methode nslices tol f a !c ;

     for i = 2 to nslices do

      d := !c +. length ;

      second := !second +. float_int_multi_adapt methode nslices tol f !c !d ;

      c := !d ;

     done ;

    end ;

    !second ;;






(** 
float_int_multi_bounded maxstages methode nslices tolerance function a b
 The method must contain the integrating method, included
the parameters, as in the following example. 
The tolerance is the relative error allowed between two steps in order to stop the slicing.




float_int_romberg 11 4




La méthode doit contenir la méthode d'intégration, y compris les paramètres, 
comme dans l'exemple ci-dessus. La tolérance est l'erreur relative admise entre deux pas pour arrêter le tranchage.
*)


let rec float_int_multi_bounded = fun (maxstages:int) methode (nslices:int) (tol:float) (f:float -> float) (a:float) (b:float) ->

 match maxstages with 

 | 0 -> methode f a b

 | _ -> 

  let first = methode f a b

  and length = ( b -. a ) /. ( float nslices ) in

   let c = ref ( a +. length )

   and d = ref 0. in

    let second = ref ( methode f a !c ) in

    for i = 2 to nslices do

     d := !c +. length ;

     second := !second +. methode f !c !d ;

     c := !d ;

    done ;

    if ( abs_float ( !second -. first ) ) > tol *. ( abs_float !second ) then

     begin

      c := a +. length ;

      second := float_int_multi_bounded ( ( abs maxstages ) - 1 ) methode nslices tol f a !c ;

      for i = 2 to nslices do

       d := !c +. length ;

       second := !second +. float_int_multi_bounded ( ( abs maxstages ) - 1 ) methode nslices tol f !c !d ;

       c := !d ;

      done ;

     end ;

     !second ;;






(** 
float_int_adapt_trapez_simpson nintervals tolerance function a b
 The tolerance is the maximal 
relative error for every step whose overshoot triggers an integral over the sub-interval.



La tolérance est l'erreur relative maximale pour chaque pas dont le dépassement 
entraîne une intégrale sur le sous-intervalle. *)


let float_int_adapt_trapez_simpson = fun (n:int) (tol:float) (f:float -> float) (a:float) (b:float) ->

 let accu = ref 0.

 and x = ref a

 and y = ref ( f a )

 and length = ( b -. a ) /. ( float n )

 and nn = n - 2

 and nnn = int_of_float ( sqrt ( float n ) )  in

  let xx = ref ( a +. length ) in

   let yy = ref ( f !xx ) in

    let z = ref ( ( !y +. !yy ) *. 0.5 ) in

     if abs_float ( !yy -. !y ) <= tol *. abs_float !z then 

      accu := !z *. length

     else accu := float_int_simpson nnn f a !xx ;

     for i = 1 to nn do

      x := !xx ;

      xx := !xx +. length ;

      y := f !x ;

      yy := f !xx ;

      z := ( !y +. !yy ) *. 0.5 ;

      if abs_float ( !yy -. !y ) <= tol *. abs_float !z then 

       accu := !accu +. !z *. length

      else accu := !accu +. float_int_simpson nnn f !x !xx ;

     done ;

     x := !xx ;

     y := f !x ;

     yy := f b ;

     z := ( !y +. !yy ) *. 0.5 ;

     if abs_float ( !yy -. !y ) <= tol *. abs_float !z then 

      accu := !accu +. !z *. length

     else accu := !accu +. float_int_simpson nnn f !x b ;

     !accu ;;






(** 
float_int_adapt methode nintervals tolerance function a b
 The method must contain the integrating method, 
included the parameters, as in the following example. 
The tolerance is the maximal relative error for every step 
whose overshoot triggers an integral over the sub-interval.




float_int_simpson 100




La méthode doit contenir la méthode d'intégration, y compris les paramètres, comme dans l'exemple ci-dessus. 
La tolérance est l'erreur relative maximale pour chaque pas dont le dépassement 
entraîne une intégrale sur le sous-intervalle.
*)


let float_int_adapt = fun methode (n:int) (tol:float) (f:float -> float) (a:float) (b:float) ->

 let accu = ref 0.

 and x = ref a

 and y = ref ( f a )

 and length = ( b -. a ) /. ( float n )

 and nn = n - 2 in

  let xx = ref ( a +. length ) in

   let yy = ref ( f !xx ) in

    let z = ref ( ( !y +. !yy ) *. 0.5 ) in

     if abs_float ( !yy -. !y ) <= tol *. abs_float !z then 

      accu := !z *. length

     else accu := methode f a !xx ;

     for i = 1 to nn do

      x := !xx ;

      xx := !xx +. length ;

      y := f !x ;

      yy := f !xx ;

      z := ( !y +. !yy ) *. 0.5 ;

      if abs_float ( !yy -. !y ) <= tol *. abs_float !z then 

       accu := !accu +. !z *. length

      else accu := !accu +. methode f !x !xx ;

     done ;

     x := !xx ;

     y := f !x ;

     yy := f b ;

     z := ( !y +. !yy ) *. 0.5 ;

     if abs_float ( !yy -. !y ) <= tol *. abs_float !z then 

      accu := !accu +. !z *. length

     else accu := !accu +. methode f !x b ;

     !accu ;;










(** 
§ 
 *)



(** 

Intégrales multiples et multidimensionnelles


Multidimensional and multiple integrals

*)



(** 
 
 *)











(** The multiple integrals are calculated over rectangular parallelepipedes.



Les intégrales multiples sont calculées sur des pavés. *)







(** 
float_int_double methode function a b
 *)


let float_int_double = fun methode (f:float array -> float) (a:float array) (b:float array) ->

 let g = function y -> methode ( function x -> f [| x ; y |] ) a.(0) b.(0) in

  methode g a.(1) b.(1) ;;




(** 
float_int_triple methode function a b
 *)


let float_int_triple = fun methode (f:float array -> float) (a:float array) (b:float array) ->

 let g = function v -> methode ( function x -> f ( Array.append [| x |] v ) ) a.(0) b.(0) in

  float_int_double methode g ( Array.sub a 1 2 ) ( Array.sub b 1 2 ) ;;




(** 
float_int_mult methode function a b
 *)


let rec float_int_mult = fun methode (f:float array -> float) (a:float array) (b:float array) ->

 let r = Array.length a in

  match r  with

  | 0 -> 0.

  | 1 -> methode ( function x -> f [| x |] ) a.(0) b.(0)

  | 2 -> float_int_double methode f a b 

  | 3 -> float_int_triple methode f a b

  | _ -> 

   let g = function v -> methode ( function x -> f ( Array.append [| x |] v ) ) a.(0) b.(0)

   and rr = r - 1 in

    float_int_mult methode g ( Array.sub a 1 rr ) ( Array.sub b 1 rr ) ;;






(** 
matrix_float_int_mult methode function a b
 *)


let rec matrix_float_int_mult = fun methode (f:float array array -> float) (a:float array array) (b:float array array) ->

 let r = Array.length a in

  match r  with

  | 0 -> 0.

  | 1 -> float_int_mult methode ( function x -> f [| x |] ) a.(0) b.(0)

  | _ -> 

   let g = function v -> float_int_mult methode ( function x -> f ( Array.append [| x |] v ) ) a.(0) b.(0)

   and rr = r - 1 in

    matrix_float_int_mult methode g ( Array.sub a 1 rr ) ( Array.sub b 1 rr ) ;;






(** 
float_vector_int methode function a b
 *)


let float_vector_int = fun methode (f:float -> float array) (a:float) (b:float) ->

 let r = Array.length ( f a ) in

  let v = Array.make r 0. in

   for i = 0 to r - 1 do

    v.(i) <- methode ( function x -> ( f x ).(i) ) a b

   done ;

   v ;;




(** 
float_matrix_int methode function a b
 *)


let float_matrix_int = fun methode (f:float -> float array array) (a:float) (b:float) ->

 let aa = ( f a ) in

  let r = Array.length aa

  and c = Array.length aa.(0) in

   let m = Array.make_matrix r c 0. in

    for i = 0 to r - 1 do

     m.(i) <- float_vector_int methode ( function x -> ( f x ).(i) ) a b

    done ;

    m ;;




(** 
vector_int_mult methode function a b
 *)


let vector_int_mult = fun methode (f:float array -> float array) (a:float array) (b:float array) ->

 let r = Array.length ( f a ) in

  let v = Array.make r 0. in

   for i = 0 to r - 1 do

    v.(i) <- float_int_mult methode ( function x -> ( f x ).(i) ) a b

   done ;

   v ;;




(** 
vector_matrix_int_mult methode function a b
 *)


let vector_matrix_int_mult = fun methode (f:float array -> float array array) (a:float array) (b:float array) ->

 let aa = ( f a ) in

  let r = Array.length aa

  and c = Array.length aa.(0) in

   let m = Array.make_matrix r c 0. in

    for i = 0 to r - 1 do

     m.(i) <- vector_int_mult methode ( function x -> ( f x ).(i) ) a b

    done ;

    m ;;






(** 
matrix_vector_int_mult methode function a b
 *)


let rec matrix_vector_int_mult = fun methode (f:float array array -> float array) (a:float array array) (b:float array array) ->

 let r = Array.length a in

  match r  with

  | 0 -> [| 0. |]

  | 1 -> vector_int_mult methode ( function x -> f [| x |] ) a.(0) b.(0)

  | _ -> 

   let g = function v -> vector_int_mult methode ( function x -> f ( Array.append [| x |] v ) ) a.(0) b.(0)

   and rr = r - 1 in

    matrix_vector_int_mult methode g ( Array.sub a 1 rr ) ( Array.sub b 1 rr ) ;;






(** 
matrix_int_mult methode function a b
 *)


let rec matrix_int_mult = fun methode (f:float array array -> float array array) (a:float array array) (b:float array array) ->

 let r = Array.length a in

  match r  with

  | 0 -> [| [| 0. |] |]

  | 1 -> vector_matrix_int_mult methode ( function x -> f [| x |] ) a.(0) b.(0)

  | _ -> 

   let g = function v -> vector_matrix_int_mult methode ( function x -> f ( Array.append [| x |] v ) ) a.(0) b.(0)

   and rr = r - 1 in

    matrix_int_mult methode g ( Array.sub a 1 rr ) ( Array.sub b 1 rr ) ;;








(** 
float_int_mult_monte_carlo samples function center range
 *)


let rec float_int_mult_monte_carlo = fun (samples:int) (f:float array -> float) (a:float array) (r:float) ->

 let l = Array.length a

 and s = float samples

 and x = ref a

 and accu = ref 0. in

  for i = 1 to samples do

   x := Matrix.vector_float_plus a ( Matrix.vector_float_bal_random l r ) ;

   accu := !accu +. f !x ;

  done ;

  !accu *. ( ( 2. *. r ) ** ( float l ) ) /. s ;;






(** 
float_compensated_int_mult_monte_carlo accelerator samples function center range
 The accelerator is appied to real numbers. The factor must be chosen 0 and 1.



L'accélérateur accelerator s'applique aux réels. Le facteur factor doit être choisi entre 0 et 1. *)


let float_compensated_int_mult_monte_carlo = fun accelerator (stages:int) (factor:float) (samples:int) (f:float array -> float) (a:float array) (r:float) ->

 let seq = Array.make stages 0.

 and aux = fun n p -> int_of_float ( ( factor ** ( float p ) ) *. ( float n ) ) in

  for i = 0 to pred stages do

   seq.(i) <- float_int_mult_monte_carlo ( aux samples ( stages - i - 1 ) ) f a r

  done ;

  accelerator seq ;;






(** 
vector_int_mult_monte_carlo samples function center range
 *)


let vector_int_mult_monte_carlo = fun (samples:int) (f:float array -> float array) (a:float array) (r:float) ->

 let l = Array.length a

 and s = float samples

 and x = ref a

 and accu = ref ( Array.make ( Array.length ( f a ) ) 0. ) in

  for i = 1 to samples do

   x := Matrix.vector_float_plus a ( Matrix.vector_float_bal_random l r ) ;

   accu := Matrix.vector_float_plus !accu ( f !x ) ;

  done ;

  Matrix.vector_float_scal_mult ( ( ( 2. *. r ) ** ( float l ) ) /. s ) !accu ;;






(** 
vector_compensated_int_mult_monte_carlo accelerator samples function center range
 The accelerator is appied to real vectors. The factor must be chosen 0 and 1.



L'accélérateur accelerator s'applique aux vecteurs réels. Le facteur factor doit être choisi entre 0 et 1. *)


let vector_compensated_int_mult_monte_carlo = fun accelerator (stages:int) (factor:float) (samples:int) (f:float array -> float array) (a:float array) (r:float) ->

 let seq = Array.make stages ( f a )

 and aux = fun n p -> int_of_float ( ( factor ** ( float p ) ) *. ( float n ) ) in

  for i = 0 to pred stages do

   seq.(i) <- vector_int_mult_monte_carlo ( aux samples ( stages - i - 1 ) ) f a r

  done ;

  accelerator seq ;;






(** 
vector_matrix_int_mult_monte_carlo samples function center range
 *)


let vector_matrix_int_mult_monte_carlo = fun (samples:int) (f:float array -> float array array) (a:float array) (r:float) ->

 let l = Array.length a

 and s = float samples

 and x = ref a

 and fa = f a in

  let accu = ref ( Array.make_matrix ( Array.length fa ) ( Array.length fa.(0) ) 0. ) in

  for i = 1 to samples do

   x := Matrix.vector_float_plus a ( Matrix.vector_float_bal_random l r ) ;

   accu := Matrix.matrix_float_plus !accu ( f !x ) ;

  done ;

  Matrix.matrix_float_scal_mult ( ( ( 2. *. r ) ** ( float l ) ) /. s ) !accu ;;






(** 
vector_matrix_compensated_int_mult_monte_carlo accelerator samples function center range
 The accelerator is appied to real matrices. The factor must be chosen 0 and 1.



L'accélérateur accelerator s'applique aux matrices réelles. Le facteur factor doit être choisi entre 0 et 1. *)


let vector_matrix_compensated_int_mult_monte_carlo = fun accelerator (stages:int) (factor:float) (samples:int) (f:float array -> float array array) (a:float array) (r:float) ->

 let seq = Array.make stages ( f a )

 and aux = fun n p -> int_of_float ( ( factor ** ( float p ) ) *. ( float n ) ) in

  for i = 0 to pred stages do

   seq.(i) <- vector_matrix_int_mult_monte_carlo ( aux samples ( stages - i - 1 ) ) f a r

  done ;

  accelerator seq ;;








(** 
surface_int_3 methode_diff methode_int f phi a b
 The first function f is a parametrization of the surface from R^2 to R^3,
the second phi is a function from R^3 to R. The integration method methode_int calculates a double integral.



La première fonction f est un paramétrage de la surface de R^2 dans R^3, la seconde phi est une fonction de R^3 dans R.
La méthode d'intégration methode_int calcule une intégrale double. *)


let surface_int_3 = fun methode_diff methode_int (f:float array -> float array) (phi:float array -> float) (a:float array) (b:float array) ->

 let g = function x -> ( phi ( f x ) ) *. ( surface_area_element_3 methode_diff f x ) in

  methode_int g a b ;;






(** 
surface_int_2_3 methode_diff methode_int f phi a b
 The first function f is a parametrization of the surface from R^2 to R^3,
the second phi is a function from R^2 to R. The integration method methode_int calculates a double integral.



La première fonction f est un paramétrage de la surface de R^2 dans R^3, la seconde phi est une fonction de R^2 dans R.
La méthode d'intégration methode_int calcule une intégrale double. *)


let surface_int_2_3 = fun methode_diff methode_int (f:float array -> float array) (phi:float array -> float) (a:float array) (b:float array) ->

 let g = function x -> ( phi x ) *. ( surface_area_element_3 methode_diff f x ) in

  methode_int g a b ;;






(** 
surface_vector_int_3 methode_diff methode_int f phi a b
 The first function f is a parametrization of the surface from R^2 to R^3,
the second phi is a function from R^3 to R^n. The integration method methode_int calculates a vector double integral.



La première fonction f est un paramétrage de la surface de R^2 dans R^3, la seconde phi est une fonction de R^3 dans R^n.
La méthode d'intégration methode_int calcule une intégrale double à valeurs vectorielles. *)


let surface_vector_int_3 = fun methode_diff methode_int (f:float array -> float array) (phi:float array -> float array) (a:float array) (b:float array) ->

 let g = function x -> Matrix.vector_float_scal_mult ( surface_area_element_3 methode_diff f x ) ( phi ( f x ) ) in

  methode_int g a b ;;






(** 
surface_vector_int_2_3 methode_diff methode_int f phi a b
 The first function f is a parametrization of the surface from R^2 to R^3,
the second phi is a function from R^2 to R^n. The integration method methode_int calculates a vector double integral.



La première fonction f est un paramétrage de la surface de R^2 dans R^3, la seconde phi est une fonction de R^2 dans R^n.
La méthode d'intégration methode_int calcule une intégrale double à valeurs vectorielles. *)


let surface_vector_int_2_3 = fun methode_diff methode_int (f:float array -> float array) (phi:float array -> float array) (a:float array) (b:float array) ->

 let g = function x -> Matrix.vector_float_scal_mult ( surface_area_element_3 methode_diff f x ) ( phi x ) in

  methode_int g a b ;;






(** 
surface_matrix_int_3 methode_diff methode_int f phi a b
 The first function f is a parametrization of the surface from R^2 to R^3,
the second phi is a function from R^3 to M(n,p,R). The integration method methode_int calculates a matrix double integral.



La première fonction f est un paramétrage de la surface de R^2 dans R^3, la seconde phi est une fonction de R^3 dans M(n,p,R).
La méthode d'intégration methode_int calcule une intégrale double à valeurs matricielles. *)


let surface_matrix_int_3 = fun methode_diff methode_int (f:float array -> float array) (phi:float array -> float array array) (a:float array) (b:float array) ->

 let g = function x -> Matrix.matrix_float_scal_mult ( surface_area_element_3 methode_diff f x ) ( phi ( f x ) ) in

  methode_int g a b ;;






(** 
surface_matrix_int_2_3 methode_diff methode_int f phi a b
 The first function f is a parametrization of the surface from R^2 to R^3,
the second phi is a function from R^2 to M(n,p,R). The integration method methode_int calculates a matrix double integral.



La première fonction f est un paramétrage de la surface de R^2 dans R^3, la seconde phi est une fonction de R^2 dans M(n,p,R).
La méthode d'intégration methode_int calcule une intégrale double à valeurs matricielles. *)


let surface_matrix_int_2_3 = fun methode_diff methode_int (f:float array -> float array) (phi:float array -> float array array) (a:float array) (b:float array) ->

 let g = function x -> Matrix.matrix_float_scal_mult ( surface_area_element_3 methode_diff f x ) ( phi x ) in

  methode_int g a b ;;






(** 
surface_vector_flux_3 methode_diff methode_int f phi a b
 The first function f is a parametrization of the surface from R^2 to R^3,
the second phi is a vector field from R^3 to R^3. The integration method methode_int calculates a double integral.



La première fonction f est un paramétrage de la surface de R^2 dans R^3, la seconde phi est une champ de vecteurs de R^3 dans R^3.
La méthode d'intégration methode_int calcule une intégrale double. *)


let surface_vector_flux_3 = fun methode_diff methode_int (f:float array -> float array) (phi:float array -> float array) (a:float array) (b:float array) ->

 let g = function x -> Matrix.vector_float_scal_prod ( surface_area_vector_3 methode_diff f x ) ( phi ( f x ) ) in

  methode_int g a b ;;






(** 
surface_vector_flux_2_3 methode_diff methode_int f phi a b
 The first function f is a parametrization of the surface from R^2 to R^3,
the second phi is a vector field from R^2 to R^3. The integration method methode_int calculates a double integral.



La première fonction f est un paramétrage de la surface de R^2 dans R^3, la seconde phi est une champ de vecteurs de R^2 dans R^3.
La méthode d'intégration methode_int calcule une intégrale double. *)


let surface_vector_flux_2_3 = fun methode_diff methode_int (f:float array -> float array) (phi:float array -> float array) (a:float array) (b:float array) ->

 let g = function x -> Matrix.vector_float_scal_prod ( surface_area_vector_3 methode_diff f x ) ( phi x ) in

  methode_int g a b ;;










(** 
§ 
 *)



(** 

Intégrales discrètes


Discrete integrals

*)



(** 
 
 *)











(** 
float_discrete_int_rect length vector
 *)


let float_discrete_int_rect = fun (length:float) (v:float array) ->

 let accu = ref 0.

 and n = Array.length v in

  for i = 0 to n - 1 do

   accu := !accu +. v.(i)

  done ;

  !accu  *. length /. ( float n ) ;;




(** 
float_discrete_int_trapez length vector
 *)


let float_discrete_int_trapez = fun (length:float) (v:float array) ->

 let nn = ( Array.length v ) - 1 in

  let accu = ref ( (v.(0) +. v.(nn) ) *. 0.5 ) in

   for i = 1 to nn - 1 do

    accu := !accu +. v.(i)

   done ;

   !accu  *. length /. ( float nn ) ;;




(** 
float_discrete_int_simpson length vector
 *)


let float_discrete_int_simpson = fun (length:float) (v:float array) ->

 let n = Array.length v in

  let vv = Array.make ( n mod 2 ) 0. in

   let w = Array.append v vv in

    let nn = Array.length w in

     let nnn = nn / 2

     and accu = ref ( ( w.(0) +. w.( nn - 1 ) ) *. 0.5 +. 2. *. w.( nn - 2 ) ) in

      for i = 1 to nnn - 1 do

       accu := !accu +. w.( 2 * i ) +. 2. *. w.( 2 * i - 1 )

      done ;

      !accu  *. length /. ( 1.5 *. float n ) ;;






(** 
float_discrete_int_interpol methode_interp methode_int length vector
 The integration method
methode_int is aimed at functions and must contain all the parameters. The interpolation
method methode_interpol must contain all the parameters.



La méthode d'intégration methode_int est destinée aux fonctions et doit contenir tous les paramètres.
La méthode d'interpolation methode_interpol doit contenir tous les paramètres. *)


let float_discrete_int_interpol = fun methode_interpol methode_int (length:float) (v:float array) ->

 let f = methode_interpol v in

  length *. ( methode_int f 0.5 ( ( float ( Array.length v ) ) -. 0.5 ) ) ;;






(** 
vector_discrete_trans_int methode length matrix
 The data are given by coordinates.



Les données sont présentées coordonnée par coordonnée. *)


let vector_discrete_trans_int = fun methode (length:float) (v:float array array) ->

 let dim = Array.length v in

  let w = Array.make dim 0. in

   for i = 0 to dim - 1 do

    w.(i) <- methode v.(i)

   done ;

   w ;;






(** 
vector_discrete_int methode length matrix
 *)


let vector_discrete_int = fun methode (length:float) (v:float array array) ->

 vector_discrete_trans_int methode length ( Matrix.float_transpose v ) ;;






(** 
float_discrete_int_double methode length_x length_y vector
 The row numbers match the ordinates
and the column numbers match the abscissae.



Les numéros de ligne de v correspondent aux ordonnées et les numéros de colonne aux abscisses. *)


let float_discrete_int_double = fun methode (length_x:float) (length_y:float) (v:float array array) ->

 let w = Array.map ( methode length_x ) v in

  methode length_y w ;;






(** 
vector_discrete_int_double methode length_x length_y vector
 The row numbers match the ordinates
and the column numbers match the abscissae.



Les numéros de ligne de v correspondent aux ordonnées et les numéros de colonne aux abscisses. *)


let vector_discrete_int_double = fun methode (length_x:float) (length_y:float) (v:float array array array) ->

 let w = Array.map ( vector_discrete_int methode length_x ) v in

  vector_discrete_int methode length_y w ;;










(** 
§ 
 *)



(** 

Transformées


Transforms

*)



(** 
 
 *)











(** 
§ 
 *)



(** 

Fonctions

*)



(** 
 
 *)











(** 
float_fourier_coefficient methode function pulsation
 The method 
must contain the integrating method, included the parameters.



La méthode doit contenir la méthode d'intégration, y compris les paramètres. *)


let float_fourier_coefficient = fun methode (f:float -> float) (n:int) ->

 let g = function x -> ( f x ) *. cos ( ( float n ) *. x )

 and h = function x -> ( f x ) *. sin ( ( float n ) *. x ) in

  let coefficient = match n with

   | 0 -> inv_doublepi

   | _ -> 1. /. pi in

    [| coefficient *. methode g 0. doublepi ; inv_doublepi *. methode h 0. doublepi |] ;;






(** 
float_fourier_coefficient_general methode beginning ending function pulsation
 The method 
must contain the integrating method, included the parameters.



La méthode doit contenir la méthode d'intégration, y compris les paramètres. *)


let float_fourier_coefficient_general = fun methode (a:float) (b:float) (f:float -> float) (n:int) ->

 let g = function x -> f ( a +. ( b -. a ) *. x *. inv_doublepi ) in

  float_fourier_coefficient methode g n ;;






(** 
float_fourier_series coefficients real
 *)


let float_fourier_series = fun (coefficients:float array array) (x:float) ->

 let accu = ref coefficients.(0).(0) in

  for i = 1 to ( Array.length coefficients ) - 1 do

   accu := !accu +. coefficients.(i).(0) *. cos ( ( float i ) *. x ) +. coefficients.(i).(1) *. sin ( ( float i ) *. x )

  done ;

  !accu ;;






(** 
float_fourier_transform methode beginning ending function pulsation
 The method 
must contain the integrating method, included the parameters.



La méthode doit contenir la méthode d'intégration, y compris les paramètres. *)


let float_fourier_transform = fun methode (a:float) (b:float) (f:float -> float) (omega:float) ->

 let g = function x -> ( f x ) *. cos ( omega *. x )

 and h = function x -> ( f x ) *. sin ( omega *. x ) in

  [| methode g a b ; -. methode h a b |] ;;






(** 
float_inv_fourier_transform methode beginning ending function pulsation
 The method 
must contain the integrating method, included the parameters.



La méthode doit contenir la méthode d'intégration, y compris les paramètres. *)


let float_inv_fourier_transform = fun methode (a:float) (b:float) (f:float -> float array) (x:float) ->

 let g = function omega -> ( f omega ).(0)

 and h = function omega -> ( f omega ).(1) in

  let k = fun omega -> ( g omega ) *. cos ( omega *. x ) -. ( h omega ) *. sin ( omega *. x ) in

   inv_doublepi *. methode k a b ;;






(** 
float_laplace_complex methode ending function parameter
 The method 
must contain the integrating method, included the parameters.



La méthode doit contenir la méthode d'intégration, y compris les paramètres. *)


let float_laplace_complex = fun methode (b:float) (f:float -> float) (p:float array) ->

 let r = -. p.(0)

 and omega = -. p.(1) in

  let g = function x -> ( f x ) *. exp ( r *. x ) *. cos ( omega *. x )

  and h = function x -> ( f x ) *. exp ( r *. x ) *. sin ( omega *. x ) in

   [| methode g 0. b ; methode h 0. b |] ;;






(** 
float_laplace_real methode ending function parameter
 The method 
must contain the integrating method, included the parameters.



La méthode doit contenir la méthode d'intégration, y compris les paramètres. *)


let float_laplace_real = fun methode (b:float) (f:float -> float) (p:float) ->

 let g = function x -> ( f x ) *. exp ( -. p *. x ) in

  methode g 0. b ;;






(** 
float_inv_laplace_complex methode abscissa ending function parameter
 The method 
must contain the integrating method, included the parameters.



La méthode doit contenir la méthode d'intégration, y compris les paramètres. *)


let float_inv_laplace_complex = fun methode (a:float) (b:float) (f:float array -> float array) (x:float) ->

  let g = function omega -> ( f [| a ; omega |] ).(0) *. exp ( a *. x ) *. cos ( omega *. x )

   -. ( f [| a ; omega |] ).(1) *. exp ( a *. x ) *. sin ( omega *. x )

  and h = function omega -> ( f [| a ; omega |] ).(1) *. exp ( a *. x ) *. cos ( omega *. x )

   +. ( f [| a ; omega |] ).(0) *. exp ( a *. x ) *. sin ( omega *. x ) in

   [| inv_doublepi *. methode g ( -. b ) b ; inv_doublepi *. methode h ( -. b ) b |] ;;






(** 
float_sumudu_real methode ending function parameter
 The method 
must contain the integrating method, included the parameters.



La méthode doit contenir la méthode d'intégration, y compris les paramètres. *)


let float_sumudu_real = fun methode (b:float) (f:float -> float) (p:float) ->

 let g = function x -> ( f x ) *. exp ( -. x /. p ) /. p in

  methode g 0. b ;;










(** 
§ 
 *)



(** 

Transformées discrètes


Discrete transforms

*)



(** 
 
 *)











(** These transforms need some normalization of variables and parameters from the user.



Ces transformées nécessitent une normalisation des variables et paramètres de la part de l'utilisateur. *)





(** 
 
 *)





(** 
discrete_float_causal_z_sequence vector complex
 *)


let discrete_float_causal_z_sequence = fun (v:float array) (z:float array) ->

 let n = Array.length v

 and coeff = 1. /. ( z.(0) *. z.(0) +. z.(1) *. z.(1) )

 and z0 = ref 1.

 and z1 = ref 0.

 and zz0 = ref 1.

 and zz1 = ref 0. in

  let w = Array.make_matrix n 2 0.

  and y = [| coeff *. z.(0) ; -. coeff *. z.(1) |] in

    for i = 0 to ( n - 1 ) do

     let row = w.(i)

     and vv = v.(i) in

      row.(0) <- vv *. !z0 ;

      row.(1) <- vv *. !z1 ;

      w.(i) <- row ;

      zz0 := !z0 *. y.(0) -. !z1 *. y.(1) ;

      zz1 := ( !z1 *. y.(0) ) +. ( !z0 *. y.(1) ) ;

      z0 := !zz0 ;

      z1 := !zz1 ;

    done ;

    w ;;




(** 
discrete_float_symmetric_z_sequence vector complex
 *)


let discrete_float_symmetric_z_sequence = fun (v:float array) (z:float array) ->

 let n = Array.length v

 and coeff = 1. /. ( z.(0) *. z.(0) +. z.(1) *. z.(1) )

 and z0 = ref 1.

 and z1 = ref 0.

 and zz0 = ref 1.

 and zz1 = ref 0. in

  let w = Array.make_matrix n 2 0.

  and nn = n / 2

  and y = [| coeff *. z.(0) ; -. coeff *. z.(1) |] in

    for i = nn to ( n - 1 ) do

     let row = w.(i)

     and vv = v.(i) in

      row.(0) <- vv *. !z0 ;

      row.(1) <- vv *. !z1 ;

      w.(i) <- row ;

      zz0 := !z0 *. y.(0) -. !z1 *. y.(1) ;

      zz1 := ( !z1 *. y.(0) ) +. ( !z0 *. y.(1) ) ;

      z0 := !zz0 ;

      z1 := !zz1 ;

    done ;

    z0 := z.(0) ;

    z1 := z.(1) ;

    zz0 := z.(0) ;

    zz1 := z.(1) ;

    for i = ( nn - 1 ) downto 0 do

     let row = w.(i)

     and vv = v.(i) in

      row.(0) <- vv *. !z0 ;

      row.(1) <- vv *. !z1 ;

      w.(i) <- row ;

      zz0 := !z0 *. z.(0) -. !z1 *. z.(1) ;

      zz1 := ( !z1 *. z.(0) ) +. ( !z0 *. z.(1) ) ;

      z0 := !zz0 ;

      z1 := !zz1 ;

    done ;

    w ;;




(** 
discrete_float_causal_z_transform vector complex
 *)


let discrete_float_causal_z_transform = fun (v:float array) (z:float array) ->

 Matrix.matrix_float_sum_by_column ( discrete_float_causal_z_sequence v z ) ;;




(** 
discrete_float_symmetric_z_transform vector complex
 *)


let discrete_float_symmetric_z_transform = fun (v:float array) (z:float array) ->

 Matrix.matrix_float_sum_by_column ( discrete_float_symmetric_z_sequence v z ) ;;




(** 
discrete_float_causal_fourier_sequence vector pulsation
 *)


let discrete_float_causal_fourier_sequence = fun (v:float array) (omega:float) ->

 discrete_float_causal_z_sequence v [| cos omega ; sin omega |] ;;




(** 
discrete_float_causal_fourier_transform vector pulsation
 This transform could be seen as a DTFT :
discrete time Fourier transform. The inversion may use float_inv_fourier_transform.



Cette transformée pourrait se ranger dans la catégorie DTFT. 
L'inversion peut utiliser float_inv_fourier_transform. *)


let discrete_float_causal_fourier_transform = fun (v:float array) (omega:float) ->

 discrete_float_causal_z_transform v [| cos omega ; sin omega |] ;;




(** 
discrete_float_symmetric_fourier_sequence vector pulsation
 *)


let discrete_float_symmetric_fourier_sequence = fun (v:float array) (omega:float) ->

 discrete_float_symmetric_z_sequence v [| cos omega ; sin omega |] ;;






(** 
discrete_float_symmetric_fourier_transform vector complex
 This transform could be seen as a DTFT :
discrete time Fourier transform. The inversion may use float_inv_fourier_transform.



Cette transformée pourrait se ranger dans la catégorie DTFT. 
L'inversion peut utiliser float_inv_fourier_transform. *)


let discrete_float_symmetric_fourier_transform = fun (v:float array) (omega:float) ->

 discrete_float_symmetric_z_transform v [| cos omega ; sin omega |] ;;










(** 
§ 
 *)



(** 

Remarque


Remark

*)



(** 
 
 *)











(** Every transform defined on functions may be applied to discrete data via the interpolation.



Toute transformée définie sur des fonctions peut s'appliquer aux données discrètes via l'interpolation. *)





(** 
 
 *)





(** 
discrete_float_transform_int methode_interpol methode_transform vector integer
 *)


let discrete_float_transform_int = fun methode_interpol methode_transform (v:float array) (n:int) ->

 let f = methode_interpol v in

  methode_transform f n ;;




(** 
discrete_float_transform_real methode_interpol methode_transform vector real
 *)


let discrete_float_transform_real = fun methode_interpol methode_transform (v:float array) (omega:float) ->

 let f = methode_interpol v in

  methode_transform f omega ;;




(** 
discrete_float_transform_complex methode_interpol methode_transform vector complex
 *)


let discrete_float_transform_complex = fun methode_interpol methode_transform (v:float array) (z:float array) ->

 let f = methode_interpol v in

  methode_transform f z ;;














(** 
§ 
 *)



(** 

Points critiques et inversions locales


Critical points and local inversions

*)



(** 
 
 *)









(** 
float_critical methode_zero methode_diff function start
 *)


let float_critical = fun methode_zero methode_diff (f:float -> float) (a:float) ->

 let g = methode_diff f in

  methode_zero g a ;;




(** 
vector_float_critical methode_zero methode_diff function start
 *)


let vector_float_critical = fun methode_zero methode_diff (f:float array -> float) (a:float array) ->

 let g = gradient methode_diff f in

  methode_zero g a ;;




(** 
vector_critical methode_zero methode_diff function start
 *)


let vector_critical = fun methode_zero methode_diff (f:float array -> float array) (a:float array) ->

 let g = function vector -> Matrix.float_slow_invertibility_evaluation ( tlm methode_diff f vector ) in

  methode_zero g a ;;




(** 
float_local_inverse methode_zero guess function real
 *)


let float_local_inverse = fun methode_zero (a:float) (f:float -> float) (x:float) ->

 let g = function y -> x -. f y in

  methode_zero g a ;;




(** 
vector_local_inverse methode_zero guess function real
 An exception
probably means that the local inversion passed through a critical point.
In this case, the start point guess has to be changed, or the method of zero finding 
should not use a tangent linear application.



Une exception signifie probablement que l'inversion locale est passée par un point critique.
Dans ce cas, il faut changer le point de départ guess ou prendre une méthode de recherche de zéro
qui n'utilise pas d'application linéaire tangente. *)


let vector_local_inverse = fun methode_zero (guess:float array) (f:float array -> float array ) (x:float array) ->

 let g = function y -> Matrix.vector_float_minus x ( f y ) in

  methode_zero g guess ;;




(** 
float_implicit_function methode_zero guess function real
 *)


let float_implicit_function = fun methode_zero (a:float) (f:float -> float -> float) (x:float) ->

 let g = function y -> f x y in

  methode_zero g a ;;




(** 
vector_implicit_function methode_zero guess function real
 *)


let vector_implicit_function = fun methode_zero (a:float array) (f:float array-> float array -> float array ) (x:float array) ->

 let g = function y -> f x y in

  methode_zero g a ;;




(** 
float_flat_search methode_zero methode_int function start length
 It is question of
searching an interval of length length and upon which the integral
of the absolute value of the function is zero.
The method of zero finding, the method of integration and a start point x have to be stated.



Il s'agit de rechercher un intervalle de longueur length sur lequel 
l'intégrale de la valeur absolue de la fonction est nulle.
Il faut préciser la méthode de recherche de zéro, la méthode d'intégration et un point de départ x. *)


let float_flat_search = fun methode_zero methode_int (f:float -> float) (x:float) (length:float) ->

 let g = function y -> abs_float ( f y ) in

  let h = function y -> methode_int g y ( length +. y ) in

   methode_zero h x ;;


















(** 
§ 
 *)



(** 

Équations différentielles ordinaires explicites y' = f(x,y)


Explicit ordinary differential equations y' = f(x,y)

*)



(** 
 
 *)











(** 
 
 *)



(** 

Méthodes explicites


Explicit methods

*)



(** 
 
 *)











(** 
float_ode_euler function nsteps value beginning ending
 *)


let float_ode_euler = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = Array.make ( nsteps + 1 ) y0 in

  for i = 1 to nsteps do

   let z = y.(i - 1) in

    y.(i) <- z +. step *. f !x z ;

    x := !x +. step ;

  done ;

  y ;;




(** 
vector_ode_euler function nsteps value beginning ending
 *)


let vector_ode_euler = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = Array.make ( nsteps + 1 ) y0 in

  for i = 1 to nsteps do

   let z = y.(i - 1) in

    y.(i) <- Matrix.vector_float_plus z ( Matrix.vector_float_scal_mult step ( f !x z ) ) ;

    x := !x +. step ;

  done ;

  y ;;




(** 
matrix_ode_euler function nsteps value beginning ending
 *)


let matrix_ode_euler = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = Array.make ( nsteps + 1 ) y0 in

  for i = 1 to nsteps do

   let z = y.(i - 1) in

    y.(i) <- Matrix.matrix_float_plus z ( Matrix.matrix_float_scal_mult step ( f !x z ) ) ;

    x := !x +. step ;

  done ;

  y ;;






(** 
float_end_ode_euler function nsteps value beginning ending
 *)


let float_end_ode_euler = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = ref y0 in

  for i = 1 to nsteps do

   y := !y +. step *. f !x !y ;

   x := !x +. step ;

  done ;

  !y ;;




(** 
vector_end_ode_euler function nsteps value beginning ending
 *)


let vector_end_ode_euler = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = ref y0 in

  for i = 1 to nsteps do

   y := Matrix.vector_float_plus !y ( Matrix.vector_float_scal_mult step ( f !x !y ) ) ;

   x := !x +. step ;

  done ;

  !y ;;




(** 
matrix_end_ode_euler function nsteps value beginning ending
 *)


let matrix_end_ode_euler = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = ref y0 in

  for i = 1 to nsteps do

   y := Matrix.matrix_float_plus !y ( Matrix.matrix_float_scal_mult step ( f !x !y ) ) ;

   x := !x +. step ;

  done ;

  !y ;;








(** 
float_ode_adams_bashforth_2 function nsteps value beginning ending
 *)


let float_ode_adams_bashforth_2 = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and accu = ref y0

 and y = Array.make ( nsteps + 1 ) y0 in

  let halfstep = step *. 0.5 in

   accu := f beginning y0 ;

   y.(1) <- y0 +. step *. !accu ;

   for i = 2 to nsteps do

    x := !x +. step ;

    let z = y.( i - 1 ) in

     let zz = f !x z in

      y.(i) <- z +. halfstep *. ( 3. *. zz -. !accu ) ;

      accu := zz ;

   done ;

   y ;;




(** 
vector_ode_adams_bashforth_2 function nsteps value beginning ending
 *)


let vector_ode_adams_bashforth_2 = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and accu = ref y0

 and y = Array.make ( nsteps + 1 ) y0 in

  let halfstep = step *. 0.5 in

   accu := f beginning y0 ;

   y.(1) <- Matrix.vector_float_plus y0 ( Matrix.vector_float_scal_mult step !accu ) ;

   for i = 2 to nsteps do

    x := !x +. step ;

    let z = y.( i - 1 ) in

     let zz = f !x z in

      y.(i) <- Matrix.vector_float_plus z ( Matrix.vector_float_scal_mult halfstep ( ( Matrix.vector_float_minus ( Matrix.vector_float_scal_mult 3. zz ) !accu ) ) ) ;

      accu := zz ;

   done ;

   y ;;




(** 
matrix_ode_adams_bashforth_2 function nsteps value beginning ending
 *)


let matrix_ode_adams_bashforth_2 = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and accu = ref y0

 and y = Array.make ( nsteps + 1 ) y0 in

  let halfstep = step *. 0.5 in

   accu := f beginning y0 ;

   y.(1) <- Matrix.matrix_float_plus y0 ( Matrix.matrix_float_scal_mult step !accu ) ;

   for i = 2 to nsteps do

    x := !x +. step ;

    let z = y.( i - 1 ) in

     let zz = f !x z in

      y.(i) <- Matrix.matrix_float_plus z ( Matrix.matrix_float_scal_mult halfstep ( ( Matrix.matrix_float_minus ( Matrix.matrix_float_scal_mult 3. zz ) !accu ) ) ) ;

      accu := zz ;

   done ;

   y ;;






(** 
float_end_ode_adams_bashforth_2 function nsteps value beginning ending
 *)


let float_end_ode_adams_bashforth_2 = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and accu = ref y0

 and y = ref y0

 and yy = ref y0

 and z = ref y0 in

  let halfstep = step *. 0.5 in

   accu := f beginning y0 ;

   y := y0 +. step *. !accu ;

   for i = 2 to nsteps do

    x := !x +. step ;

    let zz = f !x !y in

     z := !y +. halfstep *. ( 3. *. zz -. !accu ) ;

     accu := zz ;

     yy := !y ;

     y := !z ;

   done ;

   !y ;;




(** 
vector_end_ode_adams_bashforth_2 function nsteps value beginning ending
 *)


let vector_end_ode_adams_bashforth_2 = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and r = Array.length y0

 and x = ref beginning

 and y = Matrix.vector_float_copy y0

 and yy = Matrix.vector_float_copy y0

 and z = Matrix.vector_float_copy y0 in

  let halfstep = step *. 0.5

  and accu = Array.make_matrix 2 r 0.

  and rr = r - 1 in

   let zzz = f beginning y0 in

    for j = 0 to rr do 

     accu.(0).(j) <- zzz.(j) ;

     y.(j) <- y0.(j) +. step *. accu.(0).(j) ;

    done ;

    for i = 2 to nsteps do

     x := !x +. step ;

     let zz = f !x y in

      for j = 0 to rr do

       z.(j) <- y.(j) +. halfstep *. ( 3. *. zz.(j) -. accu.(0).(j) ) ;

       accu.(1).(j) <- zz.(j) ;

      done ;

      for j = 0 to rr do

       yy.(j) <- y.(j) ;

       y.(j) <- z.(j) ;

       accu.(0).(j) <- accu.(1).(j) ;

      done ;

    done ;

    y ;;




(** 
matrix_end_ode_adams_bashforth_2 function nsteps value beginning ending
 *)


let matrix_end_ode_adams_bashforth_2 = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and r = Array.length y0

 and c = Array.length y0.(0)

 and x = ref beginning

 and y = Matrix.matrix_float_copy y0

 and yy = Matrix.matrix_float_copy y0

 and z = Matrix.matrix_float_copy y0 in

  let halfstep = step *. 0.5

  and accu = [| Array.make_matrix r c 0. ; Array.make_matrix r c 0. |]

  and rr = r - 1

  and cc = c - 1 in

   let init = f beginning y0 in

    for j = 0 to rr do

     let row_input = init.(j)

     and row = y0.(j)

     and ligne = accu.(0).(j)

     and row_output = y.(j) in

      for k = 0 to cc do

       row_output.(k) <- row.(k) +. step *. row_input.(k) ;

       ligne.(k) <- row_input.(k) ;

      done ;

    done ;

    for i = 2 to nsteps do

     x := !x +. step ;

     let first = f !x y in

      for j = 0 to rr do

       let row_first = first.(j)

       and row_second = accu.(0).(j)

       and row = y.(j)

       and ligne = accu.(1).(j)

       and row_output = z.(j) in

        for k = 0 to cc do

         row_output.(k) <- row.(k) +. halfstep *. ( 3. *. row_first.(k) -. row_second.(k) ) ;

         ligne.(k) <- row_first.(k) ;

        done ;

      done ;

      for j = 0 to rr do

       yy.(j) <- Matrix.vector_float_copy y.(j) ;

       y.(j) <- Matrix.vector_float_copy z.(j) ;

       accu.(0).(j) <- accu.(1).(j) ;

      done ;

    done ;

    y ;;








(** 
float_ode_adams_bashforth_3 function nsteps value beginning ending
 *)


let float_ode_adams_bashforth_3 = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and accu = Array.make 2 0.

 and y = Array.make ( nsteps + 1 ) y0 in

  let halfstep = step *. 0.5 in

   let twelfthstep = halfstep /. 6. in

    accu.(0) <- f beginning y0 ;

    y.(1) <- y0 +. step *. accu.(0) ;

    x := !x +. step ;

    accu.(1) <- f !x y.(1) ;

    y.(2) <- y.(1) +. halfstep *. ( 3. *. accu.(1) -. accu.(0) ) ;

    for i = 3 to nsteps do

     x := !x +. step ;

     let z = y.( i - 1 ) in

      let zzz = f !x z in

       y.(i) <- z +. twelfthstep *. ( 23. *. zzz -. 16. *. accu.(1) +. 5. *. accu.(0) ) ;

       accu.(0) <- accu.(1) ;

       accu.(1) <- zzz ;

    done ;

    y ;;




(** 
vector_ode_adams_bashforth_3 function nsteps value beginning ending
 *)


let vector_ode_adams_bashforth_3 = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and r = Array.length y0

 and y = Array.make ( nsteps + 1 ) y0 in

  let halfstep = step *. 0.5

  and accu = Array.make_matrix 2 r 0. in

   let twelfthstep = halfstep /. 6.

   and zzz = f beginning y0 in

    y.(1) <- Matrix.vector_float_plus y0 ( Matrix.vector_float_scal_mult step zzz ) ;

    accu.(0) <- zzz ;

    x := !x +. step ;

    let zz = ( f !x y.(1) ) in

     y.(2) <- Matrix.vector_float_plus y.(1)

      ( Matrix.vector_float_scal_mult halfstep ( Matrix.vector_float_minus ( Matrix.vector_float_scal_mult 3. zz ) accu.(0) ) ) ;

     accu.(1) <- zz ;

     for i = 3 to nsteps do

      x := !x +. step ;

      let z = y.( i - 1 ) in

       let eval = f !x z in

        let term1 = Matrix.vector_float_scal_mult 23. eval

        and term2 = Matrix.vector_float_scal_mult (-16.) accu.(1)

        and term3 = Matrix.vector_float_scal_mult 5. accu.(0) in

         let sum = Matrix.vector_float_plus term1 ( Matrix.vector_float_plus term2 term3 ) in

          y.(i) <- Matrix.vector_float_plus z ( Matrix.vector_float_scal_mult twelfthstep sum ) ;

          accu.(0) <- accu.(1) ;

          accu.(1) <- eval ;

     done ;

     y ;;




(** 
matrix_ode_adams_bashforth_3 function nsteps value beginning ending
 *)


let matrix_ode_adams_bashforth_3 = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and r = Array.length y0

 and c = Array.length y0.(0)

 and x = ref beginning

 and y = Array.make ( nsteps + 1 ) y0 in

  let halfstep = step *. 0.5

  and accu = [| Array.make_matrix r c 0. ; Array.make_matrix r c 0. |] in

   let twelfthstep = halfstep /. 6.

   and zzz = f beginning y0 in

    y.(1) <- Matrix.matrix_float_plus y0 ( Matrix.matrix_float_scal_mult step zzz ) ;

    accu.(0) <- zzz ;

    x := !x +. step ;

    let zz = f !x y.(1) in

     y.(2) <- Matrix.matrix_float_plus y.(1)

      ( Matrix.matrix_float_scal_mult halfstep ( Matrix.matrix_float_minus ( Matrix.matrix_float_scal_mult 3. zz ) accu.(0) ) ) ;

     accu.(1) <- zz ;

     for i = 3 to nsteps do

      x := !x +. step ;

      let z = y.( i - 1 ) in

       let eval = f !x z in

        let term1 = Matrix.matrix_float_scal_mult 23. eval

        and term2 = Matrix.matrix_float_scal_mult (-16.) accu.(1)

        and term3 = Matrix.matrix_float_scal_mult 5. accu.(0) in

         let sum = Matrix.matrix_float_plus term1 ( Matrix.matrix_float_plus term2 term3 ) in

          y.(i) <- Matrix.matrix_float_plus z ( Matrix.matrix_float_scal_mult twelfthstep sum ) ;

          accu.(0) <- accu.(1) ;

          accu.(1) <- eval ;

     done ;

     y ;;






(** 
float_end_ode_adams_bashforth_3 function nsteps value beginning ending
 *)


let float_end_ode_adams_bashforth_3 = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and accu = Array.make 2 0.

 and y = ref y0

 and yy = ref y0

 and z = ref y0 in

  let halfstep = step *. 0.5 in

   let twelfthstep = halfstep /. 6. in

    let zzz = f beginning y0 in

     yy := y0 +. step *. zzz ;

     accu.(0) <- zzz ;

     x := !x +. step ;

     let zz = f !x !yy in

      y := !yy +. halfstep *. ( 3. *. zz -. accu.(0) ) ;

      accu.(1) <- zz ;

      for i = 3 to nsteps do

       x := !x +. step ;

       let eval = f !x !y in

        z := !y +. twelfthstep *. ( 23. *. eval -. 16. *. accu.(1) +. 5. *. accu.(0) ) ;

        yy := !y ;

        y := !z ;

        accu.(0) <- accu.(1) ;

        accu.(1) <- eval ;

      done ;

      !y ;;




(** 
vector_end_ode_adams_bashforth_3 function nsteps value beginning ending
 *)


let vector_end_ode_adams_bashforth_3 = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and r = Array.length y0

 and pointeur = ref 1

 and x = ref beginning in

  let halfstep = step *. 0.5

  and rr = r - 1

  and y = Array.make r 0.

  and carrousel = Array.make_matrix 3 r 0. in

   let twelfthstep = halfstep /. 6. in

    let z = f beginning y0 in

     for j = 0 to rr do

      carrousel.(0).(j) <- z.(j) ;

      y.(j) <- y0.(j) +. step *. carrousel.(0).(j) ;

     done ;

     x := !x +. step ;

     let z = f !x y in

      for j = 0 to rr do

       carrousel.(1).(j) <- z.(j) ;

       y.(j) <- y.(j) +. halfstep *. ( 3. *. carrousel.(1).(j) -. carrousel.(0).(j) ) ;

      done ;

      for i = 3 to nsteps do

       x := !x +. step ;

       pointeur := ( !pointeur + 1 ) mod 3 ;

       let z = f !x y in

        for j = 0 to rr do

         carrousel.(!pointeur).(j) <- z.(j) ;

         y.(j) <- y.(j) +. twelfthstep *. ( 23. *. carrousel.(!pointeur).(j) -. 16. *. carrousel.( ( !pointeur + 2 ) mod 3 ).(j) +. 5. *. carrousel.( ( !pointeur + 1 ) mod 3 ).(j) ) ;

        done ;

      done ;

      y ;;




(** 
matrix_end_ode_adams_bashforth_3 function nsteps value beginning ending
 *)


let matrix_end_ode_adams_bashforth_3 = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and pointeur = ref 1

 and r = Array.length y0

 and c = Array.length y0.(0)

 and x = ref beginning in

  let halfstep = step *. 0.5

  and rr = r - 1

  and cc = c - 1

  and carrousel = [| Array.make_matrix r c 0. ; Array.make_matrix r c 0. ; Array.make_matrix r c 0. |]

  and y = Matrix.matrix_float_copy y0 in

   let twelfthstep = halfstep /. 6.

   and z = f beginning y0 in

    for j = 0 to rr do

     let row_0 = y.(j)

     and ligne_0 = carrousel.(0).(j)

     and row_0_input = z.(j) in

     for k = 0 to cc do

      ligne_0.(k) <- row_0_input.(k) ;

      row_0.(k) <- row_0.(k) +. step *. row_0_input.(k) ;

     done ;

    done ;

    x := !x +. step ;

    let zz = f !x y in

     for j = 0 to rr do

      let row_1 = y.(j)

      and row_1_input = zz.(j)

      and ligne_1 = carrousel.(1).(j)

      and ligne_1_entree = carrousel.(0).(j) in

      for k = 0 to cc do

       ligne_1.(k) <- row_1_input.(k) ;

       row_1.(k) <- row_1.(k) +. halfstep *. ( 3. *. row_1_input.(k) -. ligne_1_entree.(k) ) ;

      done ;

     done ;

     for i = 3 to nsteps do

      x := !x +. step ;

      pointeur := ( !pointeur + 1 ) mod 3 ;

      let zzz = f !x y in

       for j = 0 to rr do

        let term3 = carrousel.( ( !pointeur + 1 ) mod 3 ).(j)

        and term2 = carrousel.( ( !pointeur + 2 ) mod 3 ).(j)

        and term1 = carrousel.(!pointeur).(j)

        and row_input = zzz.(j)

        and row = y.(j) in

         for k = 0 to cc do

          term1.(k) <- row_input.(k) ;

          row.(k) <- row.(k) +. twelfthstep *. ( 23. *. row_input.(k) -. 16. *. term2.(k) +. 5. *. term3.(k) ) ;

         done ;

       done ;

     done ;

     y ;;








(** 
float_ode_adams_bashforth order function nsteps value beginning ending
 *)


let float_ode_adams_bashforth = fun (order:int) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 if log ( float nsteps ) < ( float order ) *. ( log 2. ) then failwith "The number of steps [nsteps] must be at least 2 ^ [order] in Infinitesimal.float_ode_adams_bashforth." ;

 let step = ( ending -. beginning ) /. ( float nsteps )

 and oo = order - 1

 and x = ref beginning

 and carrousel = Array.make order 0.

 and y = Array.make ( nsteps + 1 ) y0 in

  let w = adams_bashforth_m.(oo) in

   for i = 1 to oo do

    let ii = i - 1 in

     carrousel.(ii) <- f !x y.(ii) ;

     y.(i) <- y.(ii) +. step *. ( Matrix.vector_float_scal_prod ( adams_bashforth_m.(ii) ) ( Array.sub carrousel 0 i ) ) ;

     x := !x +. step ;

   done ;

   for i = order to nsteps do

    let ii = i - 1 in

     carrousel.(oo) <- f !x y.(ii) ;

     y.(i) <- y.(ii) +. step *. ( Matrix.vector_float_scal_prod w carrousel ) ;

     x := !x +. step ;

     for i = 0 to oo - 1 do

      carrousel.(i) <- carrousel.( i + 1 ) ;

     done ;

   done ;

   y ;;




(** 
vector_ode_adams_bashforth order function nsteps value beginning ending
 *)


let vector_ode_adams_bashforth = fun (order:int) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 if log ( float nsteps ) < ( float order ) *. ( log 2. ) then failwith "The number of steps [nsteps] must be at least 2 ^ [order] in Infinitesimal.vector_ode_adams_bashforth." ;

 let step = ( ending -. beginning ) /. ( float nsteps )

 and ii = ref 0

 and oo = order - 1

 and l = Array.length y0

 and x = ref beginning in

  let ll = l - 1

  and carrousel = Array.make_matrix order l 0.

  and y = Array.make_matrix ( nsteps + 1 ) l 0. in

   let w = adams_bashforth_m.(oo) in

    let row = y.(0) in

     for j = 0 to ll do

      row.(j) <- y0.(j) ;

     done ;

    for i = 1 to oo do

     ii := i - 1 ;

     let row_input = y.(!ii) in

      let z = f !x row_input

      and row = carrousel.(!ii) in

       for j = 0 to ll do

        row.(j) <- z.(j) ;

       done ;

      let row = y.(i)

      and ligne = adams_bashforth_m.(!ii) in

       for j = 0 to ll do

        row.(j) <- row_input.(j) ;

        for k = 0 to !ii do

         row.(j) <- row.(j) +. step *. ligne.(k) *. carrousel.(k).(j) ;

        done ;

       done ;

     x := !x +. step ;

    done ;

    for i = order to nsteps do

     ii := i - 1 ;

     let row_input = y.(!ii) in

      let z = f !x row_input

      and row = carrousel.(oo) in

       for j = 0 to ll do

        row.(j) <- z.(j) ;

       done ;

      let row = y.(i) in

       for j = 0 to ll do

        row.(j) <- row_input.(j) ;

        for k = 0 to oo do

         row.(j) <- row.(j) +. step *. w.(k) *. carrousel.(k).(j) ;

        done ;

       done ;

      x := !x +. step ;

      for i = 0 to oo - 1 do

       let row_output = carrousel.(i)

       and row_input = carrousel.( i + 1 ) in

        for j = 0 to ll do

         row_output.(j) <- row_input.(j) ;

        done ;

      done ;

    done ;

    y ;;




(** 
matrix_ode_adams_bashforth order function nsteps value beginning ending
 *)


let matrix_ode_adams_bashforth = fun (order:int) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 if log ( float nsteps ) < ( float order ) *. ( log 2. ) then failwith "The number of steps [nsteps] must be at least 2 ^ [order] in Infinitesimal.matrix_ode_adams_bashforth." ;

 let step = ( ending -. beginning ) /. ( float nsteps )

 and ii = ref 0

 and oo = order - 1

 and l = Array.length y0

 and c = Array.length y0.(0)

 and x = ref beginning in

  let ll = l - 1

  and carrousel = Array.map ( Array.make_matrix l c ) ( Array.make order 0. )

  and y = Array.map ( Array.make_matrix l c ) ( Array.make ( nsteps + 1 ) 0. )

  and w = adams_bashforth_m.(oo) in

    let row = y.(0) in

     for j = 0 to ll do

      row.(j) <- y0.(j) ;

     done ;

    for i = 1 to oo do

     ii := i - 1 ;

     let row_input = y.(!ii) in

      let z = f !x row_input

      and row = carrousel.(!ii) in

       for j = 0 to ll do

        row.(j) <- z.(j) ;

       done ;

      let row = y.(i)

      and ligne = adams_bashforth_m.(!ii) in

       for j = 0 to ll do

        row.(j) <- row_input.(j) ;

        for k = 0 to !ii do

         row.(j) <- Matrix.vector_float_plus row.(j) ( Matrix.vector_float_scal_mult ( step *. ligne.(k) ) carrousel.(k).(j) ) ;

        done ;

       done ;

       x := !x +. step ;

    done ;

    for i = order to nsteps do

     ii := i - 1 ;

     let row_input = y.(!ii) in

      let z = f !x row_input

      and row = carrousel.(oo) in

       for j = 0 to ll do

        row.(j) <- z.(j) ;

       done ;

       let row = y.(i) in

        for j = 0 to ll do

         row.(j) <- row_input.(j) ;

         for k = 0 to oo do

          row.(j) <- Matrix.vector_float_plus row.(j) ( Matrix.vector_float_scal_mult ( step *. w.(k) ) carrousel.(k).(j) ) ;

         done ;

        done ;

       x := !x +. step ;

       for i = 0 to oo - 1 do

        let row_output = carrousel.(i)

        and row_input = carrousel.( i + 1 ) in

         for j = 0 to ll do

          row_output.(j) <- row_input.(j) ;

         done ;

       done ;

    done ;

    y ;;






(** 
float_end_ode_adams_bashforth order function nsteps value beginning ending
 *)


let float_end_ode_adams_bashforth = fun (order:int) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 if log ( float nsteps ) < ( float order ) *. ( log 2. ) then failwith "The number of steps [nsteps] must be at least 2 ^ [order] in Infinitesimal.float_end_ode_adams_bashforth." ;

 let step = ( ending -. beginning ) /. ( float nsteps )

 and oo = order - 1

 and x = ref beginning

 and carrousel = Array.make order 0.

 and y = Array.make ( order + 1 ) y0 in

  let w = adams_bashforth_m.(oo) in

   for i = 1 to oo do

    let ii = i - 1 in

     carrousel.(ii) <- f !x y.(ii) ;

     y.(i) <- y.(ii) +. step *. ( Matrix.vector_float_scal_prod ( adams_bashforth_m.(ii) ) ( Array.sub carrousel 0 i ) ) ;

     x := !x +. step ;

   done ;

   for i = order to nsteps do

    carrousel.(oo) <- f !x y.(oo) ;

    y.(order) <- y.(oo) +. step *. ( Matrix.vector_float_scal_prod w carrousel ) ;

    x := !x +. step ;

    for i = 0 to oo - 1 do

     carrousel.(i) <- carrousel.( i + 1 ) ;

    done ;

    y.(oo) <- y.(order) ;

   done ;

   y.(order) ;;






(** 
vector_end_ode_adams_bashforth order function nsteps value beginning ending
 *)


let vector_end_ode_adams_bashforth = fun (order:int) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 if log ( float nsteps ) < ( float order ) *. ( log 2. ) then failwith "The number of steps [nsteps] must be at least 2 ^ [order] in Infinitesimal.vector_end_ode_adams_bashforth." ;

 let step = ( ending -. beginning ) /. ( float nsteps )

 and l = Array.length y0

 and oo = order - 1

 and ii = ref 0

 and x = ref beginning in

  let carrousel = Array.make_matrix order l 0.

  and ll = l - 1

  and y = Array.make_matrix ( order + 1 ) l 0.

  and w = adams_bashforth_m.(oo) in

   let row = y.(0) in

    for j = 0 to ll do

     row.(j) <- y0.(j) ;

    done ;

   for i = 1 to oo do

    ii := i - 1 ;

    let row = carrousel.(!ii)

    and row_input = y.(!ii) in

     let row_output = f !x row_input in

      for j = 0 to ll do

       row.(j) <- row_output.(j) ;

      done ;

     let row = y.(i)

     and ligne = adams_bashforth_m.(!ii) in

      for j = 0 to ll do

       row.(j) <- row_input.(j) ;

       for k = 0 to !ii do

        row.(j) <- row.(j) +. step *. ligne.(k) *. carrousel.(k).(j) ;

       done ;

      done ;

    x := !x +. step ;

   done ;

   for i = order to nsteps do

    let row = carrousel.(oo)

    and z = f !x y.(oo) in

     for j = 0 to ll do

      row.(j) <- z.(j) ;

     done ;

    let row = y.(order)

    and row_input = y.(oo) in

     for j = 0 to ll do

      row.(j) <- row_input.(j) ;

      for k = 0 to oo do

       row.(j) <- row.(j) +. step *. w.(k) *. carrousel.(k).(j) ;

      done ;

     done ;

    x := !x +. step ;

    for i = 0 to oo - 1 do

     let row_output = carrousel.(i)

     and row_input = carrousel.( i + 1 ) in

      for j = 0 to ll do

       row_output.(j) <- row_input.(j) ;

      done ;

    done ;

    let row_input = y.(order)

    and row_output = y.(oo) in

     for j = 0 to ll do

      row_output.(j) <- row_input.(j) ;

     done ;

   done ;

   y.(order) ;;






(** 
matrix_end_ode_adams_bashforth order function nsteps value beginning ending
 *)


let matrix_end_ode_adams_bashforth = fun (order:int) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 if log ( float nsteps ) < ( float order ) *. ( log 2. ) then failwith "The number of steps [nsteps] must be at least 2 ^ [order] in Infinitesimal.matrix_end_ode_adams_bashforth." ;

 let step = ( ending -. beginning ) /. ( float nsteps )

 and l = Array.length y0

 and c= Array.length y0.(0)

 and oo = order - 1

 and ii = ref 0

 and x = ref beginning in

  let carrousel = Array.map ( Array.make_matrix l c ) ( Array.make order 0. )

  and ll = l - 1

  and y = Array.map ( Array.make_matrix l c ) ( Array.make ( order + 1 ) 0. )

  and w = adams_bashforth_m.(oo) in

   let row = y.(0) in

    for j = 0 to ll do

     row.(j) <- y0.(j) ;

    done ;

   for i = 1 to oo do

    ii := i - 1 ;

    let row = carrousel.(!ii)

    and row_input = y.(!ii) in

     let row_output = f !x row_input in

      for j = 0 to ll do

       row.(j) <- row_output.(j) ;

      done ;

     let row = y.(i)

     and ligne = adams_bashforth_m.(!ii) in

      for j = 0 to ll do

       row.(j) <- row_input.(j) ;

       for k = 0 to !ii do

        row.(j) <- Matrix.vector_float_plus row.(j) ( Matrix.vector_float_scal_mult ( step *. ligne.(k) ) carrousel.(k).(j) ) ;

       done ;

      done ;

    x := !x +. step ;

   done ;

   for i = order to nsteps do

    let row = carrousel.(oo)

    and z = f !x y.(oo) in

     for j = 0 to ll do

      row.(j) <- z.(j) ;

     done ;

    let row = y.(order)

    and row_input = y.(oo) in

     for j = 0 to ll do

      row.(j) <- row_input.(j) ;

      for k = 0 to oo do

       row.(j) <- Matrix.vector_float_plus row.(j) ( Matrix.vector_float_scal_mult ( step *. w.(k) ) carrousel.(k).(j) ) ;

      done ;

     done ;

    x := !x +. step ;

    for i = 0 to oo - 1 do

     let row_output = carrousel.(i)

     and row_input = carrousel.( i + 1 ) in

      for j = 0 to ll do

       row_output.(j) <- row_input.(j) ;

      done ;

    done ;

    let row_input = y.(order)

    and row_output = y.(oo) in

     for j = 0 to ll do

      row_output.(j) <- row_input.(j) ;

     done ;

   done ;

   y.(order) ;;








(** 
float_ode_nystroem_3 function nsteps value beginning ending
 *)


let float_ode_nystroem_3 = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and carrousel = Array.make 3 0.

 and pointeur = ref 1

 and y = Array.make ( nsteps + 1 ) y0 in

  let thirdstep = step /. 3. in

   carrousel.(0) <- f beginning y0 ;

   y.(1) <- y0 +. step *. carrousel.(0) ;

   x := !x +. step ;

   carrousel.(1) <- f !x y.(1) ;

   y.(2) <- y0 +. step *. 2. *. carrousel.(1) ;

   for i = 3 to nsteps do

    pointeur := ( !pointeur + 1 ) mod 3 ;

    carrousel.(!pointeur) <- f !x y.( i - 1 ) ;

    x := !x +. step ;

    let z = y.( i - 2 ) in

     y.(i) <- z +. thirdstep *. ( 7. *. carrousel.(!pointeur) -. 2. *. carrousel.( ( !pointeur + 2 ) mod 3 ) +. carrousel.( ( !pointeur + 1 ) mod 3 ) ) ;

   done ;

   y ;;




(** 
vector_ode_nystroem_3 function nsteps value beginning ending
 *)


let vector_ode_nystroem_3 = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and l = Array.length y0

 and pointeur = ref 1 in

  let carrousel = Array.make_matrix 3 l 0.

  and y = Array.make_matrix ( nsteps + 1 ) l 0.

  and ll = l - 1

  and thirdstep = step /. 3. in

   let row_input = f beginning y0

   and row = carrousel.(0) in

   for j = 0 to ll do

    row.(j) <- row_input.(j) ;

   done ;

   y.(1) <- Matrix.vector_float_plus y0 ( Matrix.vector_float_scal_mult step carrousel.(0) ) ;

   x := !x +. step ;

   let row_input = f !x y.(1)

   and row = carrousel.(1) in

    for j = 0 to ll do

     row.(j) <- row_input.(j) ;

    done ;

   y.(2) <- Matrix.vector_float_plus y0 ( Matrix.vector_float_scal_mult ( step *. 2. ) carrousel.(1) ) ;

   for i = 3 to nsteps do

    pointeur := ( !pointeur + 1 ) mod 3 ;

    let row_input = f !x y.( i - 1 )

    and row = carrousel.(!pointeur) in

     for j = 0 to ll do

      row.(j) <- row_input.(j) ;

     done ;

    x := !x +. step ;

    let z = y.( i - 2 ) in

     y.(i) <- Matrix.vector_float_plus ( Matrix.vector_float_plus z ( Matrix.vector_float_scal_mult ( thirdstep *. 7. ) carrousel.(!pointeur) ) )

      ( ( Matrix.vector_float_plus ( Matrix.vector_float_scal_mult ( -. 2. *. thirdstep ) carrousel.( ( !pointeur + 2 ) mod 3 ) ) ( Matrix.vector_float_scal_mult thirdstep carrousel.( ( !pointeur + 1 ) mod 3 ) ) ) ) ;

   done ;

   y ;;




(** 
matrix_ode_nystroem_3 function nsteps value beginning ending
 *)


let matrix_ode_nystroem_3 = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and l = Array.length y0

 and c = Array.length y0.(0)

 and pointeur = ref 1 in

  let carrousel = Array.map ( Array.make_matrix l c ) ( Array.make 3 0. )

  and y = Array.map ( Array.make_matrix l c ) ( Array.make ( nsteps + 1 ) 0. )

  and ll = l - 1

  and thirdstep = step /. 3. in

   let row_input = f beginning y0

   and row = carrousel.(0) in

   for j = 0 to ll do

    row.(j) <- row_input.(j) ;

   done ;

   y.(1) <- Matrix.matrix_float_plus y0 ( Matrix.matrix_float_scal_mult step carrousel.(0) ) ;

   x := !x +. step ;

   let row_input = f !x y.(1)

   and row = carrousel.(1) in

    for j = 0 to ll do

     row.(j) <- row_input.(j) ;

    done ;

   y.(2) <- Matrix.matrix_float_plus y0 ( Matrix.matrix_float_scal_mult ( step *. 2. ) carrousel.(1) ) ;

   for i = 3 to nsteps do

    pointeur := ( !pointeur + 1 ) mod 3 ;

    let row_input = f !x y.( i - 1 )

    and row = carrousel.(!pointeur) in

     for j = 0 to ll do

      row.(j) <- row_input.(j) ;

     done ;

    x := !x +. step ;

    let z = y.( i - 2 ) in

     y.(i) <- Matrix.matrix_float_plus ( Matrix.matrix_float_plus z ( Matrix.matrix_float_scal_mult ( thirdstep *. 7. ) carrousel.(!pointeur) ) )

      ( ( Matrix.matrix_float_plus ( Matrix.matrix_float_scal_mult ( -. 2. *. thirdstep ) carrousel.( ( !pointeur + 2 ) mod 3 ) ) ( Matrix.matrix_float_scal_mult thirdstep carrousel.( ( !pointeur + 1 ) mod 3 ) ) ) ) ;

   done ;

   y ;;








(** 
float_end_ode_nystroem_3 function nsteps value beginning ending
 *)


let float_end_ode_nystroem_3 = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and carrousel = Array.make 3 0.

 and pointeur = ref 1

 and y = ref y0

 and yy = ref y0

 and z = ref y0 in

  let thirdstep = step /. 3. in

   carrousel.(0) <- f beginning y0 ;

   yy := y0 +. step *. carrousel.(0) ;

   x := !x +. step ;

   carrousel.(1) <- f !x !yy ;

   y := y0 +. step *. 2. *. carrousel.(1) ;

   for i = 3 to nsteps do

    x := !x +. step ;

    pointeur := ( !pointeur + 1 ) mod 3 ;

    carrousel.(!pointeur) <- f !x !y ;

    z := !yy +. thirdstep *. ( 7. *. carrousel.(!pointeur) -. 2. *. carrousel.( ( !pointeur + 2 ) mod 3 ) +. carrousel.( ( !pointeur + 1 ) mod 3 ) ) ;

    yy := !y ;

    y := !z ;

   done ;

   !y ;;




(** 
vector_end_ode_nystroem_3 function nsteps value beginning ending
 *)


let vector_end_ode_nystroem_3 = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and l = Array.length y0

 and pointeur = ref 1 in

  let carrousel = Array.make_matrix 3 l 0.

  and ll = l - 1

  and y = Array.make l 0.

  and yy = Array.make l 0.

  and z = Array.make l 0.

  and thirdstep = step /. 3. in

   let row = carrousel.(0)

   and row_input = f beginning y0 in

    for j = 0 to ll do

     row.(j) <- row_input.(j) ;

     yy.(j) <- y0.(j) +. step *. row.(j) ;

    done ;

   x := !x +. step ;

   let row = carrousel.(1)

   and row_input = f !x yy in

    for j = 0 to ll do

     row.(j) <- row_input.(j) ;

     y.(j) <- y0.(j) +. step *. 2. *. row.(j) ;

    done ;

   for i = 3 to nsteps do

    x := !x +. step ;

    pointeur := ( !pointeur + 1 ) mod 3 ;

    let row = carrousel.(!pointeur)

    and row_input = f !x y in

     for j = 0 to ll do

      row.(j) <- row_input.(j) ;

      z.(j) <- yy.(j) +. thirdstep *. ( 7. *. row.(j) -. 2. *. carrousel.( ( !pointeur + 2 ) mod 3 ).(j) +. carrousel.( ( !pointeur + 1 ) mod 3 ).(j) ) ;

     done ;

    for j = 0 to ll do

     yy.(j) <- y.(j) ;

     y.(j) <- z.(j) ;

    done ;

   done ;

   y ;;




(** 
matrix_end_ode_nystroem_3 function nsteps value beginning ending
 *)


let matrix_end_ode_nystroem_3 = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and l = Array.length y0

 and c = Array.length y0.(0)

 and pointeur = ref 1 in

  let carrousel = Array.map ( Array.make_matrix l c ) ( Array.make 3 0. )

  and ll = l - 1

  and y = Array.make_matrix l c 0.

  and yy = Array.make_matrix l c 0.

  and z = Array.make_matrix l c 0.

  and thirdstep = step /. 3. in

   let row = carrousel.(0)

   and row_input = f beginning y0 in

    for j = 0 to ll do

     row.(j) <- row_input.(j) ;

     yy.(j) <- Matrix.vector_float_plus y0.(j) ( Matrix.vector_float_scal_mult step row.(j) ) ;

    done ;

   x := !x +. step ;

   let row = carrousel.(1)

   and row_input = f !x yy in

    for j = 0 to ll do

     row.(j) <- row_input.(j) ;

     y.(j) <- Matrix.vector_float_plus y0.(j) ( Matrix.vector_float_scal_mult ( step *. 2. ) row.(j) ) ;

    done ;

   for i = 3 to nsteps do

    x := !x +. step ;

    pointeur := ( !pointeur + 1 ) mod 3 ;

    let row = carrousel.(!pointeur)

    and row_input = f !x y in

     for j = 0 to ll do

      row.(j) <- row_input.(j) ;

      z.(j) <- Matrix.vector_float_plus ( Matrix.vector_float_plus yy.(j) ( Matrix.vector_float_scal_mult ( thirdstep *. 7. ) row.(j) ) )

                                        ( Matrix.vector_float_plus ( Matrix.vector_float_scal_mult ( -2. *. thirdstep ) carrousel.( ( !pointeur + 2 ) mod 3 ).(j) )

                                        ( Matrix.vector_float_scal_mult thirdstep carrousel.( ( !pointeur + 1 ) mod 3 ).(j) ) ) ;

     done ;

    for j = 0 to ll do

     yy.(j) <- y.(j) ;

     y.(j) <- z.(j) ;

    done ;

   done ;

   y ;;








(** 
float_ode_mid_point function nsteps value beginning ending
 *)


let float_ode_mid_point = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and xx = ref beginning

 and z = ref y0

 and y = Array.make ( nsteps + 1 ) y0 in

  let halfstep = step *. 0.5 in

   for i = 1 to nsteps do

    z := !z +. halfstep *. ( f !x !z ) ;

    xx := !x +. halfstep ;

    z := y.( i - 1 ) +. step *. ( f !xx !z ) ;

    x := !x +. step ;

    y.(i) <- !z ;

   done ;

   y ;;




(** 
vector_ode_mid_point function nsteps value beginning ending
 *)


let vector_ode_mid_point = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and xx = ref beginning

 and l = Array.length y0 in

  let y = Array.make_matrix ( nsteps + 1 ) l 0.

  and ll = l - 1

  and z = Array.make l 0.

  and halfstep = step *. 0.5 in

   let row = y.(0) in

    for j = 0 to ll do

     let zz = y0.(j) in

      z.(j) <- zz ;

      row.(j) <- zz ;

    done ;

   for i = 1 to nsteps do

    let row = f !x z in

     for j = 0 to ll do

      z.(j) <- z.(j) +. halfstep *. row.(j) ;

     done ;

    xx := !x +. halfstep ;

    let row = y.( i - 1 )

    and row_output = y.(i)

    and row_input = f !xx z in

     for j = 0 to ll do

      z.(j) <- row.(j) +. step *. row_input.(j) ;

      row_output.(j) <- z.(j) ;

     done ;

    x := !x +. step ;

   done ;

   y ;;




(** 
matrix_ode_mid_point function nsteps value beginning ending
 *)


let matrix_ode_mid_point = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and xx = ref beginning

 and l = Array.length y0

 and c = Array.length y0.(0) in

  let y = Array.map ( Array.make_matrix l c ) ( Array.make ( nsteps + 1 ) 0. )

  and ll = l - 1

  and z = Array.make_matrix l c 0.

  and halfstep = step *. 0.5 in

   let row = y.(0) in

    for j = 0 to ll do

     let zz = y0.(j) in

      z.(j) <- zz ;

      row.(j) <- zz ;

    done ;

   for i = 1 to nsteps do

    let row = f !x z in

     for j = 0 to ll do

      z.(j) <- Matrix.vector_float_plus z.(j) ( Matrix.vector_float_scal_mult halfstep row.(j) ) ;

     done ;

    xx := !x +. halfstep ;

    let row = y.( i - 1 )

    and row_output = y.(i)

    and row_input = f !xx z in

     for j = 0 to ll do

      z.(j) <- Matrix.vector_float_plus row.(j) ( Matrix.vector_float_scal_mult step row_input.(j) ) ;

      row_output.(j) <- z.(j) ;

     done ;

    x := !x +. step ;

   done ;

   y ;;






(** 
float_end_ode_mid_point function nsteps value beginning ending
 *)


let float_end_ode_mid_point = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and xx = ref beginning

 and y = ref y0

 and z = ref y0 in

  let halfstep = step *. 0.5 in

   for i = 1 to nsteps do

    z := !y +. halfstep *. ( f !x !y ) ;

    xx := !x +. halfstep ;

    y := !y +. step *. ( f !xx !z ) ;

    x := !x +. step ;

   done ;

   !y ;;




(** 
vector_end_ode_mid_point function nsteps value beginning ending
 *)


let vector_end_ode_mid_point = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and xx = ref beginning

 and y = Matrix.vector_float_copy y0

 and l = Array.length y0

 and z = Matrix.vector_float_copy y0 in

  let halfstep = step *. 0.5

  and ll = l - 1 in

   for i = 1 to nsteps do

    let row = f !x y in

     for j = 0 to ll do

      z.(j) <- y.(j) +. halfstep *. row.(j) ;

     done ;

    xx := !x +. halfstep ;

    let row = f !xx z in

     for j = 0 to ll do

      y.(j) <- y.(j) +. step *. row.(j) ;

     done ;

    x := !x +. step ;

   done ;

   y ;;




(** 
matrix_end_ode_mid_point function nsteps value beginning ending
 *)


let matrix_end_ode_mid_point = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and xx = ref beginning

 and y = Matrix.matrix_float_copy y0

 and l = Array.length y0

 and z = Matrix.matrix_float_copy y0 in

  let halfstep = step *. 0.5

  and ll = l - 1 in

   for i = 1 to nsteps do

    let row = f !x y in

     for j = 0 to ll do

      z.(j) <- Matrix.vector_float_plus y.(j) ( Matrix.vector_float_scal_mult halfstep row.(j) ) ;

     done ;

    xx := !x +. halfstep ;

    let row = f !xx z in

     for j = 0 to ll do

      y.(j) <- Matrix.vector_float_plus y.(j) ( Matrix.vector_float_scal_mult step row.(j) ) ;

     done ;

    x := !x +. step ;

   done ;

   y ;;








(** 
float_ode_rk4 function nsteps value beginning ending
 *)


let float_ode_rk4 = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = Array.make ( nsteps + 1 ) y0 in

  let halfstep = step *. 0.5 in

   for i = 1 to nsteps do

    let z = y.(i - 1) in

     let k1 = f !x z

     and xx = !x +. halfstep in

      let k2 = f xx ( z +. halfstep *. k1 ) in

       let k3 = f xx ( z +. halfstep *. k2 ) in

        x := !x +. step ;

        let k4 = f !x ( z +. step *. k3 ) in

        y.(i) <- z +. ( halfstep *. ( k1 +. k4 ) +. step *. ( k2 +. k3 ) ) /. 3. ;

   done ;

   y ;;




(** 
vector_ode_rk4 function nsteps value beginning ending
 *)


let vector_ode_rk4 = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and l = Array.length y0 in

  let y = Array.make_matrix ( nsteps + 1 ) l 0.

  and ll = l - 1

  and halfstep = step *. 0.5

  and thirdstep = step /. 3. in

   let sixthstep = thirdstep *. 0.5 in

    let row = y.(0) in

     for j = 0 to ll do

      row.(j) <- y0.(j) ;

     done ;

    for i = 1 to nsteps do

     let z = y.(i - 1) in

      let k1 = f !x z

      and xx = !x +. halfstep in

       let k2 = f xx ( Matrix.vector_float_plus z ( Matrix.vector_float_scal_mult halfstep k1 ) ) in

        let k3 = f xx ( Matrix.vector_float_plus z ( Matrix.vector_float_scal_mult halfstep k2 ) ) in

         x := !x +. step ;

         let k4 = f !x ( Matrix.vector_float_plus z ( Matrix.vector_float_scal_mult step k3 ) ) in

         y.(i) <- Matrix.vector_float_plus z ( Matrix.vector_float_plus ( Matrix.vector_float_scal_mult sixthstep ( Matrix.vector_float_plus k1 k4 ) )

                                                                        ( Matrix.vector_float_scal_mult thirdstep ( Matrix.vector_float_plus k2 k3 ) ) ) ;

   done ;

   y ;;




(** 
matrix_ode_rk4 function nsteps value beginning ending
 *)


let matrix_ode_rk4 = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and l = Array.length y0

 and c = Array.length y0.(0) in

  let y = Array.map ( Array.make_matrix l c ) ( Array.make ( nsteps + 1 ) 0. )

  and ll = l - 1

  and halfstep = step *. 0.5

  and thirdstep = step /. 3. in

   let sixthstep = thirdstep *. 0.5 in

    let row = y.(0) in

     for j = 0 to ll do

      row.(j) <- y0.(j) ;

     done ;

    for i = 1 to nsteps do

     let z = y.(i - 1) in

      let k1 = f !x z

      and xx = !x +. halfstep in

       let k2 = f xx ( Matrix.matrix_float_plus z ( Matrix.matrix_float_scal_mult halfstep k1 ) ) in

        let k3 = f xx ( Matrix.matrix_float_plus z ( Matrix.matrix_float_scal_mult halfstep k2 ) ) in

         x := !x +. step ;

         let k4 = f !x ( Matrix.matrix_float_plus z ( Matrix.matrix_float_scal_mult step k3 ) ) in

         y.(i) <- Matrix.matrix_float_plus z ( Matrix.matrix_float_plus ( Matrix.matrix_float_scal_mult sixthstep ( Matrix.matrix_float_plus k1 k4 ) )

                                                                        ( Matrix.matrix_float_scal_mult thirdstep ( Matrix.matrix_float_plus k2 k3 ) ) ) ;

    done ;

    y ;;






(** 
float_end_ode_rk4 function nsteps value beginning ending
 *)


let float_end_ode_rk4 = fun (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = ref y0

 and z = ref y0 in

  let halfstep = step *. 0.5 in

   for i = 1 to nsteps do

    let k1 = f !x !y

    and xx = !x +. halfstep in

     let k2 = f xx ( !y +. halfstep *. k1 ) in

      let k3 = f xx ( !y +. halfstep *. k2 ) in

       x := !x +. step ;

       let k4 = f !x ( !y +. step *. k3 ) in

        z := !y +. ( halfstep *. ( k1 +. k4 ) +. step *. ( k2 +. k3 ) ) /. 3. ;

        y := !z ;

   done ;

   !y ;;




(** 
vector_end_ode_rk4 function nsteps value beginning ending
 *)


let vector_end_ode_rk4 = fun (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and l = Array.length y0

 and y = Matrix.vector_float_copy y0 in

  let z = Array.make l 0.

  and ll = l - 1

  and halfstep = step *. 0.5 in

   for i = 1 to nsteps do

    let k1 = f !x y

    and xx = !x +. halfstep in

     let k2 = f xx ( Matrix.vector_float_plus y ( Matrix.vector_float_scal_mult halfstep k1 ) ) in

      let k3 = f xx ( Matrix.vector_float_plus y ( Matrix.vector_float_scal_mult halfstep k2 ) ) in

       x := !x +. step ;

       let k4 = f !x ( Matrix.vector_float_plus y ( Matrix.vector_float_scal_mult step k3 ) ) in

        for j = 0 to ll do

         z.(j) <- y.(j) +. ( halfstep *. ( k1.(j) +. k4.(j) ) +. step *. ( k2.(j) +. k3.(j) ) ) /. 3. ;

         y.(j) <- z.(j) ;

        done ;

   done ;

   y ;;




(** 
matrix_end_ode_rk4 function nsteps value beginning ending
 *)


let matrix_end_ode_rk4 = fun (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and l = Array.length y0

 and c = Array.length y0.(0)

 and y = Matrix.matrix_float_copy y0 in

  let z = Array.make_matrix l c 0.

  and ll = l - 1

  and thirdstep = step /. 3.

  and halfstep = step *. 0.5 in

   let sixthstep = thirdstep *. 0.5 in

    for i = 1 to nsteps do

     let k1 = f !x y

     and xx = !x +. halfstep in

      let k2 = f xx ( Matrix.matrix_float_plus y ( Matrix.matrix_float_scal_mult halfstep k1 ) ) in

       let k3 = f xx ( Matrix.matrix_float_plus y ( Matrix.matrix_float_scal_mult halfstep k2 ) ) in

        x := !x +. step ;

        let k4 = f !x ( Matrix.matrix_float_plus y ( Matrix.matrix_float_scal_mult step k3 ) ) in

         for j = 0 to ll do

          z.(j) <- Matrix.vector_float_plus y.(j) 

                                            ( Matrix.vector_float_plus ( Matrix.vector_float_scal_mult sixthstep ( Matrix.vector_float_plus k1.(j) k4.(j) ) )

                                                                       ( Matrix.vector_float_scal_mult thirdstep ( Matrix.vector_float_plus k2.(j) k3.(j) ) ) ) ;

          y.(j) <- z.(j) ;

         done ;

    done ;

    y ;;








(** 
float_ode_runge_kutta butcher_matrix butcher_vector function nsteps value beginning ending
 *)


let float_ode_runge_kutta = fun (a:float array array) (b:float array) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = ref y0

 and zz = ref 0.

 and y = Array.make ( nsteps + 1 ) y0 in

  let c = Array.make l 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.make l y0

  and k = Array.make ( l + 1 ) 0. in

   for i = 0 to ll do

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

     xx := x.(0) ;

     z := y.( i - 1 ) ;

     k.(0) <- f !xx !z ;

     for j = 0 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      yy.(j) <- !z ;

      let row = a.(j) in

       for index = 0 to j do

        zz := !zz +. row.(index) *. k.(index) ;

       done ;

       yy.(j) <- yy.(j) +. step *. !zz ;

       zz := 0. ;

       k.( j + 1 ) <- f x.(j) yy.(j) ;

     done ;

     x.(0) <- !xx +. step ;

     for j = 0 to l do

      zz := !zz +. b.(j) *. k.(j) ;

     done ;

     y.(i) <- !z +. step *. !zz ;

     zz := 0. ;

   done ;

   y ;;






(** 
vector_ode_runge_kutta butcher_matrix butcher_vector function nsteps value beginning ending
 *)


let vector_ode_runge_kutta = fun (a:float array array) (b:float array) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and dim = Array.length y0 in

  let c = Array.make l 0.

  and z = Matrix.vector_float_copy y0

  and zz = Array.make dim 0.

  and y = Array.make_matrix ( nsteps + 1 ) dim 0.

  and ll = l - 1

  and dd = dim - 1

  and x = Array.make l beginning

  and yy = Array.make_matrix l dim 0.

  and k = Array.make_matrix ( l + 1 ) dim 0. in

   for i = 0 to ll do

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   let row = y.(0) in

    for j = 0 to dd do

     row.(j) <- y0.(j)

    done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    let row = y.( i - 1 )

    and ligne = k.(0) in

     let image = f !xx row in

      for j = 0 to dd do

       z.(j) <- row.(j) ;

       ligne.(j) <- image.(j)

      done ;

     for j = 0 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- z.(indice) ;

       done ;

      let row = a.(j) in

       for index = 0 to j do

        let coeff = row.(index)

        and ligne = k.(index) in

         for indice = 0 to dd do

          zz.(indice) <- zz.(indice) +. coeff *. ligne.(indice) ;

         done ;

       done ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- row.(indice) +. step *. zz.(indice) ;

       done ;

      let row = k.( j + 1 )

      and image = f x.(j) yy.(j) in

       for indice = 0 to dd do

        zz.(indice) <- 0. ;

        row.(indice) <- image.(indice) ;

       done ;

     done ;

     x.(0) <- !xx +. step ;

     for j = 0 to l do

      let row = k.(j)

      and coeff = b.(j) in

       for indice = 0 to dd do

        zz.(indice) <- zz.(indice) +. coeff *. row.(indice) ;

       done ;

     done ;

     let row = y.(i) in

      for indice = 0 to dd do

       row.(indice) <- z.(indice) +. step *. zz.(indice) ;

       zz.(indice) <- 0. ;

      done ;

   done ;

   y ;;






(** 
matrix_ode_runge_kutta butcher_matrix butcher_vector function nsteps value beginning ending
 *)


let matrix_ode_runge_kutta = fun (a:float array array) (b:float array) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and dim_r = Array.length y0

 and dim_c = Array.length y0.(0) in

  let c = Array.make l 0.

  and z = Matrix.matrix_float_copy y0

  and zz = Array.make_matrix dim_r dim_c 0.

  and y = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( nsteps + 1 ) 0. )

  and ll = l - 1

  and dd = dim_r - 1

  and cc = dim_c - 1

  and x = Array.make l beginning

  and yy = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make l 0. )

  and k = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( l + 1 ) 0. ) in

   for i = 0 to ll do

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   let row = y.(0) in

    for j = 0 to dd do

     row.(j) <- Matrix.vector_float_copy y0.(j)

    done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    let row = y.( i - 1 )

    and ligne = k.(0) in

     let image = f !xx row in

      for j = 0 to dd do

       z.(j) <- row.(j) ;

       ligne.(j) <- image.(j)

      done ;

     for j = 0 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- Matrix.vector_float_copy z.(indice) ;

       done ;

      let row = a.(j) in

       for index = 0 to j do

        let coeff = row.(index)

        and ligne = k.(index) in

         for indice = 0 to dd do

          zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff ligne.(indice) ) ;

         done ;

       done ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- Matrix.vector_float_plus row.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

       done ;

      let row = k.( j + 1 )

      and image = f x.(j) yy.(j) in

       for indice = 0 to dd do

        let ligne = zz.(indice) in

         for numero = 0 to cc do

          ligne.(numero) <- 0. ;

         done ;

        row.(indice) <- image.(indice) ;

       done ;

     done ;

     x.(0) <- !xx +. step ;

     for j = 0 to l do

      let row = k.(j)

      and coeff = b.(j) in

       for indice = 0 to dd do

        zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff row.(indice) ) ;

       done ;

     done ;

     let row = y.(i) in

      for indice = 0 to dd do

       row.(indice) <- Matrix.vector_float_plus z.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

       let row = zz.(indice) in

        for numero = 0 to cc do

         row.(numero) <- 0. ;

        done ;

      done ;

   done ;

   y ;;








(** 
float_end_ode_runge_kutta butcher_matrix butcher_vector function nsteps value beginning ending
 *)


let float_end_ode_runge_kutta = fun (a:float array array) (b:float array) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = ref y0

 and zz = ref 0.

 and y = ref y0 in

  let c = Array.make l 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.make l y0

  and k = Array.make ( l + 1 ) 0. in

   for i = 0 to ll do

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    z := !y ;

    k.(0) <- f !xx !z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     yy.(j) <- !z ;

     let row = a.(j) in

      for index = 0 to j do

       zz := !zz +. row.(index) *. k.(index) ;

      done ;

      yy.(j) <- yy.(j) +. step *. !zz ;

      zz := 0. ;

      k.( j + 1 ) <- f x.(j) yy.(j) ;

    done ;

    x.(0) <- !xx +. step ;

    for j = 0 to l do

     zz := !zz +. b.(j) *. k.(j) ;

    done ;

    y := !z +. step *. !zz ;

    zz := 0. ;

   done ;

   !y ;;




(** 
vector_end_ode_runge_kutta butcher_matrix butcher_vector function nsteps value beginning ending
 *)


let vector_end_ode_runge_kutta = fun (a:float array array) (b:float array) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and dim = Array.length y0

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = Matrix.vector_float_copy y0

 and y = Matrix.vector_float_copy y0 in

  let c = Array.make l 0.

  and zz = Array.make dim 0.

  and ll = l - 1

  and dd = dim - 1

  and x = Array.make l beginning

  and yy = Array.make_matrix l dim 0.

  and k = Array.make_matrix ( l + 1 ) dim 0. in

   for i = 0 to ll do

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    for indice = 0 to dd do

     z.(indice) <- y.(indice) ;

    done ;

    k.(0) <- f !xx z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     let yyy = yy.(j) in

      for indice = 0 to dd do

       yyy.(indice) <- z.(indice) ;

      done ;

     let row = a.(j) in

      for index = 0 to j do

       let ligne = k.(index)

       and coeff = row.(index) in

        for indice = 0 to dd do

         zz.(indice) <- zz.(indice) +. coeff *. ligne.(indice) ;

        done ;

      done ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- row.(indice) +. step *. zz.(indice) ;

        zz.(indice) <- 0. ;

       done ;

       k.( j + 1 ) <- f x.(j) row ;

     done ;

     x.(0) <- !xx +. step ;

     for j = 0 to l do

      let row = k.(j)

      and coeff = b.(j) in

       for indice = 0 to dd do

        zz.(indice) <- zz.(indice) +. coeff *. row.(indice) ;

       done ;

     done ;

     for indice = 0 to dd do

      y.(indice) <- z.(indice) +. step *. zz.(indice) ;

      zz.(indice) <- 0. ;

     done ;

   done ;

   y ;;




(** 
matrix_end_ode_runge_kutta butcher_matrix butcher_vector function nsteps value beginning ending
 *)


let matrix_end_ode_runge_kutta = fun (a:float array array) (b:float array) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and dim_r = Array.length y0

 and dim_c = Array.length y0.(0)

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = Matrix.matrix_float_copy y0

 and y = Matrix.matrix_float_copy y0 in

  let c = Array.make l 0.

  and zz = Array.make_matrix dim_r dim_c 0.

  and ll = l - 1

  and dd = dim_r - 1

  and cc = dim_c - 1

  and x = Array.make l beginning

  and yy = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make l 0. )

  and k = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( l + 1 ) 0. ) in

   for i = 0 to ll do

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    for indice = 0 to dd do

     z.(indice) <- y.(indice) ;

    done ;

    k.(0) <- f !xx z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     let yyy = yy.(j) in

      for indice = 0 to dd do

       yyy.(indice) <- z.(indice) ;

      done ;

     let row = a.(j) in

      for index = 0 to j do

       let ligne = k.(index)

       and coeff = row.(index) in

        for indice = 0 to dd do

         zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff ligne.(indice) ) ;

        done ;

      done ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- Matrix.vector_float_plus row.(indice) ( Matrix.vector_float_scal_mult  step zz.(indice) ) ;

        let ligne = zz.(indice) in

         for numero = 0 to cc do

          ligne.(numero) <- 0. ;

         done ;

       done ;

       k.( j + 1 ) <- f x.(j) row ;

     done ;

     x.(0) <- !xx +. step ;

     for j = 0 to l do

      let row = k.(j)

      and coeff = b.(j) in

       for indice = 0 to dd do

        zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff row.(indice) ) ;

       done ;

     done ;

     for indice = 0 to dd do

      y.(indice) <- Matrix.vector_float_plus z.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

      let ligne = zz.(indice) in

       for numero = 0 to cc do

        ligne.(numero) <- 0. ;

       done ;

     done ;

   done ;

   y ;;








(** 
§ 
 *)







(** Some Butcher tableaus are following. They have been harvested on the internet.
The square matrix must be lower triangular in the strict sense.
The tableaus of the explicit adaptative methods quoted further may also be used.



Suivent quelques tableaux de Butcher. Ils ont été glanés sur internet. 
La matrice carrée doit être triangulaire inférieure au sens strict.
Les tableaux des méthodes adaptatives explicites cités plus loin peuvent aussi être exploités. 




 
 *)




let euler_a = ([| [| |] |]:float array array) ;;


(** *)


let euler_b = [| 1. |] ;;



let mid_point_a = [| [| 0.5 |] |] ;;


(** *)


let mid_point_b = [| 0. ; 1. |] ;;



let imex_ssp2_2_2_2_a = [| [| 1. |] |] ;;


(** The previous method is also called Lobatto III for s = 2.



La méthode ci-dessus est aussi appelée Lobatto III pour s = 2. *)


let imex_ssp2_2_2_2_b = [| 0.5 ; 0.5 |] ;;



let heun_a = [| [| 1. /. 3. |] ; [| 0. ; 2. /. 3. |] |] ;;


(** *)


let heun_b = [| 0.25 ; 0. ; 0.75 |] ;;



let rk2_runge_a = [| [| 1. |] ; [| 0. ; 1. |] |] ;;


(** *)


let rk2_runge_b = [| 0.5 ; 0. ; 0.5 |] ;;



let imex_ssp2_3_2_2_a = [| [| 0. |] ; [| 0. ; 1. |] |] ;;


(** *)


let imex_ssp2_3_2_2_b = [| 0. ; 0.5 ; 0.5 |] ;;



let imex_ssp2_3_3_2_a = [| [| 0.5 |] ; [| 0.5 ; 0.5 |] |] ;;


(** *)


let imex_ssp2_3_3_2_b = [| 1. /. 3. ; 1. /. 3. ; 1. /. 3. |] ;;



let imex_ssp3_3_3_2_a = [| [| 1. |] ; [| 0.25 ; 0.25 |] |] ;;


(** *)


let imex_ssp3_3_3_2_b = [| 1. /. 6. ; 1. /. 6. ; 2. /. 3. |] ;;



let example_a = [| [| 2. /. 3. |] ; [| -1. ; 1. |] |] ;;


(** *)


let example_b = [| 0. ; 0.75 ; 0.25 |] ;;



let imex_ssp3_4_3_3_a = [| [| 0. |] ; [| 0. ; 1. |] ; [| 0. ; 0.25 ; 0.25 |] |] ;;


(** *)


let imex_ssp3_4_3_3_b = [| 0. ; 1. /. 6. ; 1. /. 6. ; 2. /. 3. |] ;;



let rk4_a = [| [| 0.5 |] ; [| 0. ; 0.5 |] ; [| 0. ; 0. ; 1. |] |] ;;


(** *)


let rk4_b = [| 1./.6. ; 1. /. 3. ; 1. /. 3. ; 1. /. 6. |] ;;



let rk4_3_8_a = [| [| 1. /. 3. |] ; [| -1. /. 3. ; 1. |] ; [| 1. ; -1. ; 1. |] |] ;;


(** *)


let rk4_3_8_b = [| 1. /. 8. ; 3. /. 8. ; 3. /. 8. ; 1. /. 8. |] ;;



let hem_4_5_a = [| [| 0.3 |] ; [| ( 1. +. sqrt_of_6 ) /. 30. ; ( 11. -. 4. *. sqrt_of_6 ) /. 30. |] ;

 [| (-79. -. 31. *. sqrt_of_6 ) /. 150. ; ( -1. -. 4. *. sqrt_of_6 ) /. 30. ; ( 24. +. 11. *. sqrt_of_6 ) /. 25. |] ;

 [| ( 14. +. 5. *. sqrt_of_6 ) /. 6. ; ( 7. *. sqrt_of_6 -. 8. ) /. 6. ; ( -9. -. 7. *. sqrt_of_6 ) /. 4. ; ( 9. -. sqrt_of_6 ) /. 4. |] |] ;;


(** *)


let hem_4_5_b = [| 0. ; 0. ; ( 16. -. sqrt_of_6 ) /. 36. ; ( 16. +. sqrt_of_6 ) /. 36. ; 1. /. 9. |] ;;



let rk5_kutta_first_a = [| [| 0.2 |] ; [| 0. ; 0.4 |] ; [| 2.25 ; -5. ; 3.75 |] ; [| -0.63 ; 1.8 ; -0.65 ; 0.08 |] ; [| -0.24 ; 0.8 ; 2. /. 15. ; 8. /. 75. ; 0. |] |] ;;


(** *)


let rk5_kutta_first_b = [| 17. /. 144. ; 0. ; 100. /. 144. ; 2. /. 144. ; -50. /. 144. ; 75. /. 144. |] ;;



let rk5_kutta_second_a = [| [| 1. /. 3. |] ; [| 0.16 ; 0.24 |] ; [| 0.25 ; -3. ; 3.75 |] ; [| 2. /. 27. ; 10. /. 9. ; -50. /. 81. ; 8. /. 81. |] ;

 [| 0.08 ; 0.48 ; 2. /. 15. ; 8. /. 75. ; 0. |] |] ;;


(** *)


let rk5_kutta_second_b = [| 23. /. 192. ; 0. ; 125. /. 192. ; 0. ; -27. /. 64. ; 125. /. 192. |] ;;



let rk5_cassity_a = [| [| 1. /. 7. |] ; [| -367. /. 4088. ; 261. /. 584. |] ; [| 41991. /. 2044. ; -2493. /. 73. ; 57. /. 4. |] ;

 [| -108413. /. 196224. ; 58865. /. 65408. ; 5. /. 16. ; 265. /. 1344. |] ; [| -204419. /. 58984. ; 143829. /. 58984. ; 171. /. 202. ; 2205. /. 404. ; -432. /. 101. |] |] ;;


(** *)


let rk5_cassity_b = [| 1. /. 9. ; 7. /. 2700. ; 413. /. 810. ; 7. /. 450. ; 28. /. 75. ; -101. /. 8100. |] ;;



let rk6_butcher_a = [| [| 0.5 -. sqrt_of_5 /. 10. |] ; [| -. sqrt_of_5 /. 10. ; 0.5 +. sqrt_of_5 /. 5. |] ;

 [| ( -15. +. 7. *. sqrt_of_5 ) /. 20. ; -0.25 +. sqrt_of_5 /. 4. ; ( 15. -. 7. *. sqrt_of_5 ) /. 10. |] ;

 [| ( 5. -. sqrt_of_5 ) /. 60. ; 0. ; 1. /. 6. ; ( 15. -. 7. *. sqrt_of_5 ) /. 60. |] ;

 [| ( 5. -. sqrt_of_5 ) /. 60. ; 0. ; ( 9. -. 5. *. sqrt_of_5 ) /. 12. ; 1. /. 6. ; -0.5 +. 0.3 *. sqrt_of_5 |] ;

 [| 1. /. 6. ; 0. ; ( -55. +. 25. *. sqrt_of_5 ) /. 12. ; ( -25. -. 7. *. sqrt_of_5 ) /. 12. ; 5. -. 2. *. sqrt_of_5 ; 2.5 +. 0.5 *. sqrt_of_5 |] |] ;;


(** *)


let rk6_butcher_b = [| 1. /. 12. ; 0. ; 0. ; 0. ; 5. /. 12. ; 5. /. 12. ; 1. /. 12. |] ;;










(** 
§ 
 *)



(** 

Méthodes implicites avec résolution unidimensionnelle


Implicit Methods with unidimensional resolution

*)



(** 
 
 *)











(** 
float_ode_back_euler methode function nsteps value beginning ending
 The method must contain the solving method, included
the method of derivation and all the parameters, as in the following example.




 y' = f(x,y) float_zero_householder ( float_richardson_deriv 3. 4 1e-3 ) 3 100




La méthode doit contenir la méthode de résolution, y compris la méthode de dérivation et tous les paramètres, 
comme dans l'exemple ci-dessus.
*)


let float_ode_back_euler = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = Array.make ( nsteps + 1 ) y0 in

  for i = 1 to nsteps do

   x := !x +. step ;

   let z = y.(i - 1) in

    let g = function t -> z +. step *. ( f !x t ) -. t in

     y.(i) <- methode g z ;

  done ;

  y ;;






(** 
float_end_ode_back_euler methode function nsteps value beginning ending
 The method must contain the solving method, included
the method of derivation and all the parameters, as in the following example.




 y' = f(x,y) float_zero_householder ( float_richardson_deriv 3. 4 1e-3 ) 3 100




La méthode doit contenir la méthode de résolution, y compris la méthode de dérivation et tous les paramètres, 
comme dans l'exemple ci-dessus.
*)


let float_end_ode_back_euler = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = ref y0 in

  for i = 1 to nsteps do

   x := !x +. step ;

   let g = function t -> !y +. step *. ( f !x t ) -. t in

    y := methode g !y ;

  done ;

  !y ;;






(** 
float_ode_trapezoid methode function nsteps value beginning ending
 The method must contain the solving method, included
the method of derivation and all the parameters, as in the following example.




float_zero_householder ( float_richardson_deriv 3. 4 1e-3 ) 3 100




La méthode doit contenir la méthode de résolution, y compris la méthode de dérivation et tous les paramètres, 
comme dans l'exemple ci-dessus.
*)


let float_ode_trapezoid = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = Array.make ( nsteps + 1 ) y0 in

  let halfstep = step *. 0.5 in

   for i = 1 to nsteps do

    let z = y.(i - 1) in

     let zz = f !x z in

      x := !x +. step ;

      let g = function t -> z +. halfstep *. ( zz +. f !x t ) -. t in

       y.(i) <- methode g z ;

   done ;

   y ;;






(** 
float_end_ode_trapezoid methode function nsteps value beginning ending
 The method must contain the solving method, included
the method of derivation and all the parameters, as in the following example.




float_zero_householder ( float_richardson_deriv 3. 4 1e-3 ) 3 100




La méthode doit contenir la méthode de résolution, y compris la méthode de dérivation et tous les paramètres, 
comme dans l'exemple ci-dessus.
*)


let float_end_ode_trapezoid = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = ref y0 in

  let halfstep = step *. 0.5 in

   for i = 1 to nsteps do

    let z = !y in

     let zz = f !x z in

      x := !x +. step ;

      let g = function t -> z +. halfstep *. ( zz +. f !x t ) -. t in

       y := methode g z ;

   done ;

   !y ;;






(** 
float_ode_adams_moulton_2 methode function nsteps value beginning ending
 *)


let float_ode_adams_moulton_2 = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = Array.make ( nsteps + 1 ) y0

 and zz = Array.make ( nsteps + 1 ) ( f beginning y0 ) in

  let halfstep = step *. 0.5 in

   let twelfthstep = halfstep /. 6. in

    x := !x +. step ;

    let g = function t -> y0 -. t +. step *. f !x t in

     y.(1) <- methode g y0 ;

    zz.(1) <- f !x y.(1) ;

    for i = 2 to nsteps do

     x := !x +. step ;

     let z = y.( i - 1 ) in

      let g = function t -> z -. t +. twelfthstep *. ( 5. *. ( f !x t ) +. 8. *. zz.( i - 1 ) -. zz.( i - 2 ) ) in

       y.(i) <- methode g z ;

      zz.(i) <- f !x y.(i) ; 

    done ;

    y ;;






(** 
float_end_ode_adams_moulton_2 methode function nsteps value beginning ending
 *)


let float_end_ode_adams_moulton_2 = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = ref y0

 and yy = ref y0

 and zzz = ref ( f beginning y0 )

 and zz = ref 0. in

  let halfstep = step *. 0.5 in

   let twelfthstep = halfstep /. 6. in

    x := !x +. step ;

    let g = function t -> y0 -. t +. step *. f !x t in

     y := methode g y0 ;

    zz := f !x !y ;

    for i = 2 to nsteps do

     x := !x +. step ;

     let z = !y in

      let g = function t -> z -. t +. twelfthstep *. ( 5. *. ( f !x t ) +. 8. *. ( f ( !x -. step ) z ) -. ( f ( !x -. 2. *. step ) !yy ) ) in

       y := methode g z ;

       yy := z ;

     zzz := !zz ;

     zz := f !x !y ;

    done ;

    !y ;;






(** 
float_ode_milne_simpson_2 methode function nsteps value beginning ending
 *)


let float_ode_milne_simpson_2 = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and zzz = Array.make ( nsteps + 1 ) ( f beginning y0 )

 and y = Array.make ( nsteps + 1 ) y0 in

  let thirdstep = step /. 3. in

   x := !x +. step ;

   let g = function t -> y0 -. t +. step *. f !x t in

    y.(1) <- methode g y0 ;

   zzz.(1) <- f !x y.(1) ;

   for i = 2 to nsteps do

    x := !x +. step ;

    let z = y.( i - 2 )

    and zz = y.( i - 1 ) in

     let g = function t -> z -. t +. thirdstep *. ( ( f !x t ) +. 4. *. zzz.( i - 1 ) +. zzz.( i - 2 ) ) in

      y.(i) <- methode g zz ;

     zzz.(i) <- f !x y.(i) ;

   done ;

   y ;;






(** 
float_end_ode_milne_simpson_2 methode function nsteps value beginning ending
 *)


let float_end_ode_milne_simpson_2 = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = ref y0 

 and yy = ref y0

 and zz = ref 0.

 and zzz = ref ( f beginning y0 )

 and z = ref y0 in

  let thirdstep = step /. 3. in

   x := !x +. step ;

   let g = function t -> y0 -. t +. step *. f !x t in

    y := methode g y0 ;

   zz := f !x !y ;

   for i = 2 to nsteps do

    x := !x +. step ;

    let g = function t -> !yy -. t +. thirdstep *. ( ( f !x t ) +. 4. *. !zz +. !zzz ) in

     z := methode g !y ;

     yy := !y ;

     y := !z ;

    zzz := !zz ;

    zz := f !x !y ;

   done ;

   !y ;;






(** 
float_ode_bdf_2 methode function nsteps value beginning ending
 *)


let float_ode_bdf_2 = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = Array.make ( nsteps + 1 ) y0 in

  x := !x +. step ;

  let g = function t -> y0 -. t +. step *. f !x t in

   y.(1) <- methode g y0 ;

  for i = 2 to nsteps do

   x := !x +. step ;

   let z = y.( i - 1 ) in

    let g = function t -> 3. *. t -. 4. *. z +. y.( i - 2 ) -. 2. *. step *. ( f !x t ) in

     y.(i) <- methode g z ;

  done ;

  y ;;






(** 
float_end_ode_bdf_2 methode function nsteps value beginning ending
 *)


let float_end_ode_bdf_2 = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = ref y0

 and yy = ref y0

 and z = ref y0 in

  x := !x +. step ;

  let g = function t -> y0 -. t +. step *. f !x t in

   y := methode g y0 ;

  for i = 2 to nsteps do

   x := !x +. step ;

   let g = function t -> 3. *. t -. 4. *. !y +. !yy -. 2. *. step *. ( f !x t ) in

    z := methode g !y ;

    yy := !y ;

    y := !z ;

  done ;

  !y ;;






(** 
float_ode_bdf_3 methode function nsteps value beginning ending
 *)


let float_ode_bdf_3 = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = Array.make ( nsteps + 1 ) y0 in

  x := !x +. step ;

  let g = function t -> y0 -. t +. step *. f !x t in

   y.(1) <- methode g y0 ;

  x := !x +. step ;

  let g = function t -> 3. *. t -. 4. *. y.(1) +. y0 -. 2. *. step *. ( f !x t ) in

   y.(2) <- methode g y.(1) ;

  for i = 3 to nsteps do

   x := !x +. step ;

   let z = y.( i - 1 ) in

    let g = function t -> 11. *. t -. 18. *. z +. 9. *. y.( i - 2 ) -. 2. *. y.( i - 3 ) -. 6. *. step *. ( f !x t ) in

     y.(i) <- methode g z ;

  done ;

  y ;;






(** 
float_end_ode_bdf_3 methode function nsteps value beginning ending
 *)


let float_end_ode_bdf_3 = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = ref y0

 and yy = ref y0

 and yyy = ref y0

 and z = ref y0 in

  x := !x +. step ;

  let g = function t -> y0 -. t +. step *. f !x t in

   yy := methode g y0 ;

  x := !x +. step ;

  let g = function t -> 3. *. t -. 4. *. !yy +. y0 -. 2. *. step *. ( f !x t ) in

   y := methode g !yy ;

  for i = 3 to nsteps do

   x := !x +. step ;

   let g = function t -> 11. *. t -. 18. *. !y +. 9. *. !yy -. 2. *. !yyy -. 6. *. step *. ( f !x t ) in

    z := methode g !y ;

    yyy := !yy ;

    yy := !y ;

    y := !z ;

  done ;

  !y ;;










(** 
float_ode_bdf_4 methode function nsteps value beginning ending
 *)


let float_ode_bdf_4 = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = Array.make ( nsteps + 1 ) y0 in

  x := !x +. step ;

  let g = function t -> y0 -. t +. step *. f !x t in

   y.(1) <- methode g y0 ;

  x := !x +. step ;

  let g = function t -> 3. *. t -. 4. *. y.(1) +. y0 -. 2. *. step *. ( f !x t ) in

   y.(2) <- methode g y.(1) ;

  x := !x +. step ;

  let g = function t -> 11. *. t -. 18. *. y.(2) +. 9. *. y.(1) -. 2. *. y0 -. 6. *. step *. ( f !x t ) in

   y.(3) <- methode g y.(2) ;

  for i = 4 to nsteps do

   x := !x +. step ;

   let z = y.( i - 1 ) in

    let g = function t -> 25. *. t -. 48. *. z +. 36. *. y.( i - 2 ) -. 16. *. y.( i - 3 ) +. 3. *. y.( i - 4 ) -. 12. *. step *. ( f !x t ) in

     y.(i) <- methode g z ;

  done ;

  y ;;






(** 
float_end_ode_bdf_4 methode function nsteps value beginning ending
 *)


let float_end_ode_bdf_4 = fun methode (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and y = ref y0

 and yy = ref y0

 and yyy = ref y0

 and yyyy = ref y0

 and z = ref y0 in

  x := !x +. step ;

  let g = function t -> y0 -. t +. step *. f !x t in

   yyy := methode g y0 ;

  x := !x +. step ;

  let g = function t -> 3. *. t -. 4. *. !yyy +. y0 -. 2. *. step *. ( f !x t ) in

   yy := methode g !yyy ;

  x := !x +. step ;

  let g = function t -> 11. *. t -. 18. *. !y +. 9. *. !yy -. 2. *. !yyy -. 6. *. step *. ( f !x t ) in

   y := methode g !yy ;

  for i = 4 to nsteps do

   x := !x +. step ;

   let g = function t -> 25. *. t -. 48. *. !y +. 36. *. !yy -. 16. *. !yyy +. 3. *. !yyyy -. 12. *. step *. ( f !x t ) in

    z := methode g !y ;

    yyy := !yy ;

    yy := !y ;

    y := !z ;

  done ;

  !y ;;






(** 
float_ode_runge_kutta_impl methode butcher_matrix butcher_vector function nsteps value beginning ending
 *)


let float_ode_runge_kutta_impl = fun methode (a:float array array) (b:float array) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = ref y0

 and zz = ref 0.

 and y = Array.make ( nsteps + 1 ) y0 in

  let c = Array.make l 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.make l y0

  and k = Array.make l 0. in

   for i = 0 to ll do

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

     xx := x.(0) ;

     z := y.( i - 1 ) ;

     let g = function t -> f ( !xx +. c.(0) *. step ) ( !z +. step *. a.(0).(0) *. t ) -. t in

     k.(0) <- methode g !z ;

     for j = 1 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      yy.(j) <- !z ;

      let row = a.(j) in

       for index = 0 to j - 1 do

        zz := !zz +. row.(index) *. k.(index) *. step ;

       done ;

       let g = function t -> ( f ( !xx +. c.(j) *. step ) ( !z +. !zz +. row.(j) *. step *. t ) ) -. t in

       k.( j ) <- methode g !zz ;

     done ;

     x.(0) <- !xx +. step ;

     for j = 0 to ll do

      zz := !zz +. b.(j) *. k.(j) ;

     done ;

     y.(i) <- !z +. step *. !zz ;

     zz := 0. ;

   done ;

   y ;;






(** 
float_end_ode_runge_kutta_impl methode butcher_matrix butcher_vector function nsteps value beginning ending
 *)


let float_end_ode_runge_kutta_impl = fun methode (a:float array array) (b:float array) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = ref y0

 and zz = ref 0.

 and y = ref y0 in

  let c = Array.make l 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.make l y0

  and k = Array.make l 0. in

   for i = 0 to ll do

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

     xx := x.(0) ;

     z := !y ;

     let g = function t -> f ( !xx +. c.(0) *. step ) ( !z +. step *. a.(0).(0) *. t ) -. t in

     k.(0) <- methode g !z ;

     for j = 1 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      yy.(j) <- !z ;

      let row = a.(j) in

       for index = 0 to j - 1 do

        zz := !zz +. row.(index) *. k.(index) *. step ;

       done ;

       let g = function t -> ( f ( !xx +. c.(j) *. step ) ( !z +. !zz +. row.(j) *. step *. t ) ) -. t in

       k.( j ) <- methode g !zz ;

     done ;

     x.(0) <- !xx +. step ;

     for j = 0 to ll do

      zz := !zz +. b.(j) *. k.(j) ;

     done ;

     y := !z +. step *. !zz ;

     zz := 0. ;

   done ;

   !y ;;








(** 
§ 
 *)







(** Some Butcher tableaus are following. They have been harvested on the internet.
The square matrix must be lower triangular in the loose sense.
(excepted in the particular case of the trapezoidal method).
Some tableaus quoted in the methods with multidimensional resolution
may be used if they satisfy the condition.



Suivent quelques tableaux de Butcher. Ils ont été glanés sur internet.
La matrice carrée doit être triangulaire inférieure au sens large.
(sauf dans le cas particulier de la méthode trapézoïdale).
Certains tableaux cités dans les méthodes à résolution multidimansionnelle
peuvent donc être utilisés s'ils répondent à la condition.




 
 *)




let backward_euler_a = [| [| 1. |] |] ;;


(** *)


let backward_euler_b = [| 1. |] ;;



let rk1_gauss_a = [| [| 0.5 |] |] ;;


(** *)


let rk1_gauss_b = [| 1. |] ;;



let rk2_burrage_a = [| [| 0.25 ; 0. |] ; [| 0.5 ; 0.25 |] |] ;;


(** *)


let rk2_burrage_b = [| 0.5 ; 0.5 |] ;;



let rk2_radauI_a = [| [| 0. ; 0. |] ; [| 1. /. 3. ; 1. /. 3. |] |] ;;


(** *)


let rk2_radauI_b = [| 0.25 ; 0.75 |] ;;



let rk2_radauII_a = [| [| 1. /. 3. ; 0. |] ; [| 1. ; 0. |] |] ;;


(** *)


let rk2_radauII_b = [| 0.75 ; 0.25 |] ;;



let rk2_sdirk_2A_b  = [| inv_sqrt_of_2 ; 1. -. inv_sqrt_of_2 |] ;;


(** *)


let rk2_sdirk_2A_a = [| [| 1. -. inv_sqrt_of_2 ; 0. |] ; rk2_sdirk_2A_b |] ;;



let rk2_sdirk_2B_b  = [| -. inv_sqrt_of_2 ; 1. +. inv_sqrt_of_2 |] ;;


(** *)


let rk2_sdirk_2B_a = [| [| 1. +. inv_sqrt_of_2 ; 0. |] ; rk2_sdirk_2B_b |] ;;



let rk2_sdirk_3A_b  = [| 0.5 -. 0.5 *. inv_sqrt_of_3 ; inv_sqrt_of_3 ; 0.5 -. 0.5 *. inv_sqrt_of_3 |] ;;


(** *)


let rk2_sdirk_3A_a = [| [| rk2_sdirk_3A_b.(0) ; 0. ; 0. |] ; [| rk2_sdirk_3A_b.(0) ; rk2_sdirk_3A_b.(0) ; 0. |] ; rk2_sdirk_3A_b |] ;; 



let rk3_example_a = [| [| 1. /. 3. ; 0. |] ; [| 1. ; 0. |] |] ;;


(** *)


let rk3_example_b = [| 0.75 ; 0.25 |] ;;



let imex_ssp2_2_2_2_impl_a = [| [| 1. -. 1. /. sqrt_of_2 ; 0. |] ; [| sqrt_of_2 -. 1. ; 1. -. 1. /. sqrt_of_2 |] |] ;;


(** *)


let imex_ssp2_2_2_2_impl_b = imex_ssp2_2_2_2_b ;;



let imex_ssp2_3_2_2_impl_a = [| [| 0.5 ; 0. ; 0. |] ; [| -0.5 ; 0.5 ; 0. |] ; [| 0. ; 0.5 ; 0.5 |] |] ;;


(** *)


let imex_ssp2_3_2_2_impl_b = imex_ssp2_3_2_2_b ;;



let imex_ssp2_3_3_2_impl_a = [| [| 0.25 ; 0. ; 0. |] ; [| 0. ; 0.25 ; 0. |] ; [| 1. /. 3. ; 1. /. 3. ; 1. /. 3. |] |] ;;


(** *)


let imex_ssp2_3_3_2_impl_b = imex_ssp2_3_3_2_b ;;



let imex_ssp3_3_3_2_impl_a = [| [| 1. -. 1. /. sqrt_of_2 ; 0. ; 0. |] ; [| sqrt_of_2 -. 1. ; 1. -. 1. /. sqrt_of_2 ; 0. |] ;

 [| 1. /. sqrt_of_2 -. 0.5 ; 0. ; 1. -. 1. /. sqrt_of_2 |] |] ;;


(** *)


let imex_ssp3_3_3_2_impl_b = imex_ssp3_3_3_2_b ;;



let mod_ext_bdf_a = [| [| 1. ; 0. ; 0. |] ; [| 1. ; 1. ; 0. |] ; [| 0.5 ; -0.5 ; 1. |] |] ;;


(** *)


let mod_ext_bdf_b = [| 0.5 ; -0.5 ; 1. |] ;;



let lambda_example_start = 0.4358665215 ;;

let lambda_example_polynom = function x -> ( ( 18. -. 6. *. x ) *. x -. 9. ) *. x +. 1. ;;

let lambda_example = float_zero_general ( float_richardson_binary_deriv 4 1e-3 ) 3 100 lambda_example_polynom lambda_example_start ;;

let lambda_example_b = [| ( 4. -. 1.5 *. lambda_example ) *. lambda_example -. 0.25 ;

 ( 1.5 *. lambda_example -. 5. ) *. lambda_example  +. 1.25 ; lambda_example |] ;;


(** *)


let lambda_example_a = [| [| lambda_example ; 0. ; 0. |] ; [| ( 1. -. lambda_example ) *. 0.5 ; lambda_example ; 0. |] ; lambda_example_b |] ;;



let imex = [| 0.24169426078821 ;  0.06042356519705 ;  0.12915286960590 |] ;;

let imex_ssp3_4_3_3_impl_a = [| [| imex.(0) ; 0. ; 0. ; 0. |] ; [| -. imex.(0) ; imex.(0) ; 0. ; 0. |] ; [| 0. ; 1. -. imex.(0) ; imex.(0) ; 0. |] ;

 [| imex.(1) ; imex.(2) ; 0.5 -. imex.(0) -. imex.(1) -. imex.(2) ; imex.(0) |] |] ;;


(** *)


let imex_ssp3_4_3_3_impl_b = imex_ssp3_4_3_3_b



let rk5_try_a = [| [| 0. ; 0. ; 0. ; 0. |] ; [| 0.125 ; 0.125 ; 0. ; 0. |] ; [| -0.01 ; 0.56 ; 0.15 ; 0. |] ; [| 2. /. 7. ; 0. ; 5. /. 7. ; 0. |] |] ;;


(** *)


let rk5_try_b = [| 1. /. 14. ; 32. /. 81. ; 250. /. 567. ; 5. /. 54. |] ;;










(** 
§ 
 *)



(** 

Méthodes implicites avec résolution multidimensionnelle


Implicit Methods with multidimensional resolution

*)



(** 
 
 *)











(** 
float_ode_runge_kutta_impl_multi methode butcher_matrix butcher_vector function nsteps value beginning ending
 *)


let float_ode_runge_kutta_impl_multi = fun methode (a:float array array) (b:float array) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = ref y0

 and zz = ref 0.

 and y = Array.make ( nsteps + 1 ) y0 in

  let c = Array.make l 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.make l y0

  and k = ref ( Array.make l 0. ) in

   for i = 0 to ll do

    let row = a.(i) in

     for j = 0 to ll do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

     xx := x.(0) ;

     z := y.( i - 1 ) ;

     let g = function t ->

      begin

       let u = ref ( Matrix.matrix_vector_float_prod a t ) in

        u := Matrix.vector_float_scal_mult step !u ;

        u := Matrix.vector_float_scal_add !z !u ; 

        for j = 0 to ll do

         x.(j) <- !xx +. step *. c.(j) ;

         !u.(j) <- t.(j) -. f x.(j) !u.(j) ;

         yy.(j) <- !z ;

        done ;

        !u

      end in

      k := methode g yy ;

      x.(0) <- !xx +. step ;

      for j = 0 to ll do

       zz := !zz +. b.(j) *. !k.(j) ;

      done ;

      y.(i) <- !z +. step *. !zz ;

      zz := 0. ;

   done ;

   y ;;






(** 
float_end_ode_runge_kutta_impl_multi methode butcher_matrix butcher_vector function nsteps value beginning ending
 *)


let float_end_ode_runge_kutta_impl_multi = fun methode (a:float array array) (b:float array) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = ref y0

 and zz = ref 0.

 and y = ref y0 in

  let c = Array.make l 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.make l y0

  and k = ref ( Array.make l 0. ) in

   for i = 0 to ll do

    let row = a.(i) in

     for j = 0 to ll do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

     xx := x.(0) ;

     z := !y ;

     let g = function t ->

      begin

       let u = ref ( Matrix.matrix_vector_float_prod a t ) in

        u := Matrix.vector_float_scal_mult step !u ;

        u := Matrix.vector_float_scal_add !z !u ; 

        for j = 0 to ll do

         x.(j) <- !xx +. step *. c.(j) ;

         !u.(j) <- t.(j) -. f x.(j) !u.(j) ;

         yy.(j) <- !z ;

        done ;

        !u

      end in

      k := methode g ( yy ) ;

      x.(0) <- !xx +. step ;

      for j = 0 to ll do

       zz := !zz +. b.(j) *. !k.(j) ;

      done ;

      y := !z +. step *. !zz ;

      zz := 0. ;

   done ;

   !y ;;








(** 
§ 
 *)







(** Some Butcher tableaus are following. They have been harvested on the internet.



Suivent quelques tableaux de Butcher. Ils ont été glanés sur internet. 




 
 *)




let trapezoid_a = [| [| 0.5 ; 0.5 |] ; [| 0. ; 0. |] |] ;;


(** *)


let trapezoid_b = [| 0.5 ; 0.5 |] ;;



let rk2_gauss_a = [| [| 0.25 ; 0.25 -. sqrt 3. /. 6. |] ; [| 0.25 +. sqrt 3. /. 6. ; 0.25 |] |] ;;


(** *)


let rk2_gauss_b = [| 0.5 ; 0.5 |] ;;



let rk2_radauIA_a = [| [| 0.25 ; -0.25 |] ; [| 0.25 ; 5. /. 12. |] |] ;;


(** *)


let rk2_radauIA_b = [| 0.25 ; 0.75 |] ;;



let rk2_radauIIA_a = [| [| 5. /. 12. ; -1. /. 12. |] ; [| 0.75 ; 0.25 |] |] ;;


(** *)


let rk2_radauIIA_b = [| 0.75 ; 0.25 |] ;;



let rk3_gauss_a = [| [| 5. /. 36. ; 2. /. 9. -. 1. /. sqrt_of_15 ; 5. /. 36. -. 0.5 /. sqrt_of_15 |] ;

 [|  5. /. 36. +. sqrt_of_15 /. 24. ; 2. /. 9. ; 5. /. 36. -. sqrt_of_15 /. 24. |] ; 

 [| 5. /. 36. +. 0.5 /. sqrt_of_15 ; 2. /. 9. +. 1. /. sqrt_of_15 ; 5. /. 36. |] |] ;;


(** *)


let rk3_gauss_b = [| 5. /. 18. ; 4. /. 9. ; 5. /. 18. |] ;;



let rk3_radauI_a = [| [| 0. ; 0. ; 0. |] ; [| ( 9. +. sqrt_of_6 ) /. 75. ; 0.2 +. sqrt_of_6 /. 120. ; 0.28 -. 73. *. sqrt_of_6 /. 600. |] ;

 [| ( 9. -. sqrt_of_6 ) /. 75. ; 0.28 +. 73. *. sqrt_of_6 /. 600. ; 0.2 -. sqrt_of_6 /. 120. |] |] ;; 


(** *)


let rk3_radauI_b = [| 1. /. 9. ; ( 16. +. sqrt_of_6 ) /. 36. ; ( 16. -. sqrt_of_6 ) /. 36. |] ;;



let rk5_radauIA_a = [| [| 1. /. 9. ; ( -1. -. sqrt_of_6 ) /. 18. ; ( -1. +. sqrt_of_6 ) /. 18. |] ;

 [| 1. /. 9. ; ( 88. +. 7. *. sqrt_of_6 ) /. 360. ; ( 88. -. 43. *. sqrt_of_6 ) /. 360. |] ;

 [| 1. /. 9. ; ( 88. +. 43. *. sqrt_of_6 ) /. 360. ; ( 88. -. 7. *. sqrt_of_6 ) /. 360. |] |] ;;


(** *)


let rk5_radauIA_b = rk3_radauI_b ;;



let rk3_radauII_a = [| [| 0.2 -. sqrt_of_6 /. 120. ; 0.2 -. 11. *. sqrt_of_6 /. 120. ; 0. |] ; [| 0.2 +. 11. *. sqrt_of_6 /. 120. ; 0.2 +. sqrt_of_6 /. 120. ; 0. |] ; 

 [| 0.5 -. 0.5 /. sqrt_of_6 ; 0.5 +. 0.5 /. sqrt_of_6 ; 0. |] |] ;;


(** *)


let rk3_radauII_b = [| ( 16. -. sqrt_of_6 ) /. 36. ; ( 16. +. sqrt_of_6 ) /. 36. ; 1. /. 9. |] ;;



let rk3_radauIIA_b = [| ( 16. -. sqrt_of_6 ) /. 36. ; ( 16. +. sqrt_of_6 ) /. 36. ; 1. /. 9. |] ;;


(** *)


let rk3_radauIIA_a = [| [| ( 88. -. 7. *. sqrt_of_6 ) /. 360. ; ( 296. -. 169. *. sqrt_of_6 ) /. 1800. ; ( -2. +. 3. *. sqrt_of_6 ) /. 225. |] ; 

[| ( 296. +. 169. *. sqrt_of_6 ) /. 1800. ; ( 88. +. 7. *. sqrt_of_6 ) /. 360. ; ( -2. -. 3. *. sqrt_of_6 ) /. 225. |] ; rk3_radauIIA_b |] ;;



let rk5_radauIIA_a = [| [| 9.1232394870892942792e-2 ; -0.14125529502095420843 ; -3.0029194105147424492e-2 |] ; 

[| 0.24171793270710701896 ; 0.20412935229379993199 ; 0.38294211275726193779 |] ; 

[| 0.96604818261509293619 ; 1. ; 0. |] |] ;;



let rk5_radauIIA_a_inv = [| [| 4.3255798900631553510 ; 0.33919925181580986954 ; 0.54177053993587487119 |] ; 

[| -4.1787185915519047273 ; -0.32768282076106238708 ; 0.47662355450055045196 |] ; 

[| -0.50287263494578687595 ; 2.5719269498556054292 ; -0.59603920482822492497 |] |] ;;



let rk5_radauIIA_b = [| -. ( 13. +. 7. *. sqrt_of_6 ) /. 3. ; ( -13. +. 7. *. sqrt_of_6 ) /. 3. ; -1. /. 3. |] ;;





let rk9_radauIIA_b = [| -0.2778093394406463730479e2 ; 0.3641478498049213152712e1 ;

-0.1252547721169118720491e1 ; 0.5920031671845428725662 ; -0.2 |] ;;



let rk9_radauIIA_a = [| [| -0.1251758622050104589014e-1 ; -0.1024204781790882707009e-1 ;

 0.4767387729029572386318e-1 ; -0.1147851525522951470794e-1 ; -0.1401985889287541028108e-1 |] ; 

[| -0.1491670151895382429004e-2 ; 0.5017286451737105816299e-1 ; -0.9433181918161143698066e-1 ; 

-0.7668830749180162885157e-2 ; 0.2470857842651852681253e-1 |] ; 

[| -0.7298187638808714862266e-1 ; -0.2305395340434179467214 ; 0.1027030453801258997922 ; 

0.1939846399882895091122e-1 ; 0.8180035370375117083639e-1 |] ; 

[| -0.3800914400035681041264 ; 0.3778939022488612495439 ; 0.4667441303324943592896 ; 

0.4076011712801990666217 ; 0.1996824278868025259365 |] ; 

[| -0.9219789736812104884883 ; 1. ; 0.0 ; 1. ; 0.0 |] |] ;;



let rk9_radauIIA_a_inv = [| [| -0.3004156772154440162771e2 ; -0.1386510785627141316518e2 ; 

-0.3480002774795185561828e1 ; 0.1032008797825263422771e1 ; -0.8043030450739899174753 |] ; 

[| 0.5344186437834911598895e1 ; 0.4593615567759161004454e1 ; -0.3036360323459424298646e1 ; 

0.1050660190231458863860e1 ; -0.2727786118642962705386 |] ; 

[| 0.3748059807439804860051e1 ; -0.3984965736343884667252e1 ; -0.1044415641608018792942e1 ; 

0.1184098568137948487231e1 ; -0.4499177701567803688988 |] ; 

[| -0.3304188021351900000806e2 ; -0.1737695347906356701945e2 ; -0.1721290632540055611515 ; 

-0.9916977798254264258817e-1 ; 0.5312281158383066671849 |] ; 

[| -0.8611443979875291977700e1 ; 0.9699991409528808231336e1 ; 0.1914728639696874284851e1 ; 

0.2418692006084940026427e1 ; -0.1047463487935337418694e1 |] |] ;;





let rk13_radauIIA_b = [| -0.5437443689412861451458e2 ; 0.7000024004259186512041e1 ; -0.2355661091987557192256e1 ; 

0.1132289066106134386384e1 ; -0.6468913267673587118673 ; 0.3875333853753523774248 ; -0.1428571428571428571429 |] ;;



let rk13_radauIIA_a = [| [| -0.2153754627310526422828e-2 ; 0.2156755135132077338691e-1 ; 0.8783567925144144407326e-2 ; 

-0.4055161452331023898198e-2 ; 0.4427232753268285479678e-2 ; -0.1238646187952874056377e-2 ; -0.2760617480543852499548e-2 |] ; 

[| 0.1600025077880428526831e-2 ; -0.3813164813441154669442e-1 ; -0.2152556059400687552385e-1 ; 0.8415568276559589237177e-2 ; 

-0.4031949570224549492304e-2 ; -0.6666635339396338181761e-4 ; 0.3185474825166209848748e-2 |] ; 

[| -0.4059107301947683091650e-2 ; 0.5739650893938171539757e-1 ; 0.5885052920842679105612e-1 ; -0.8560431061603432060177e-2 ; 

-0.6923212665023908924141e-2 ; -0.2352180982943338340535e-2 ; 0.4169077725297562691409e-3 |] ; 

[| -0.1575048807937684420346e-1 ; -0.3821469359696835048464e-1 ; -0.1657368112729438512412 ; -0.3737124230238445741907e-1 ; 

0.8239007298507719404499e-2 ; 0.3115071152346175252726e-2 ; 0.2511660491343882192836e-1 |] ; 

[| -0.1129776610242208076086 ; -0.2491742124652636863308 ; 0.2735633057986623212132 ; 0.5366761379181770094279e-2 ; 

0.1932111161012620144312 ; 0.1017177324817151468081 ; 0.9504502035604622821039e-1 |] ; 

[| -0.4583810431839315010281 ; 0.5315846490836284292051 ; 0.4863228366175728940567 ; 0.5265742264584492629141 ; 

0.2755343949896258141929 ; 0.5217519452747652852946 ; 0.1280719446355438944141 |] ; 

[| -0.8813915783538183763135 ; 1. ; 0. ; 1. ; 0. ; 1. ; 0. |] |] ;;



let rk13_radauIIA_a_inv = [| [| -0.2581319263199822292761e3 ; -0.1890737630813985089520e3 ; -0.4908731481793013119445e2 ; 

-0.4110647469661428418112e1 ; -0.4053447889315563304175e1 ; 0.3112755366607346076554e1 ; -0.1646774913558444650169e1 |] ; 

[| -0.3007390169451292131731e1 ; -0.1101586607876577132911e2 ; 0.1487799456131656281486e1 ; 0.2130388159559282459432e1 ; 

-0.1816141086817565624822e1 ; 0.1134325587895161100083e1 ; -0.4146990459433035319930 |] ; 

[| -0.8441963188321084681757e1 ; -0.6505252740575150028169 ; 0.6940670730369876478804e1 ; -0.3205047525597898431565e1 ; 

0.1071280943546478589783e1 ; -0.3548507491216221879730 ; 0.9198549132786554154409e-1 |] ; 

[| 0.7467833223502269977153e2 ; 0.8740858897990081640204e2 ; 0.4024158737379997877014e1 ; -0.3714806315158364186639e1 ; 

-0.3430093985982317350741e1 ; 0.2696604809765312378853e1 ; -0.9386927436075461933568 |] ; 

[| 0.5835652885190657724237e2 ; -0.1006877395780018096325e2 ; -0.3036638884256667120811e2 ; -0.1020020865184865985027e1 ; 

-0.1124175003784249621267 ; 0.1890640831000377622800e1 ; -0.9716486393831482282172 |] ; 

[| -0.2991862480282520966786e3 ; -0.2430407453687447911819e3 ; -0.4877710407803786921219e2 ; -0.2038671905741934405280e1 ; 

0.1673560239861084944268e1 ; -0.1087374032057106164456e1 ; 0.9019382492960993738427 |] ; 

[| -0.9307650289743530591157e2 ; 0.2388163105628114427703e2 ; 0.3927888073081384382710e2 ; 0.1438891568549108006988e2 ; 

-0.3510438399399361221087e1 ; 0.4863284885566180701215e1 ; -0.2246482729591239916400e1 |] |] ;;





let rk2_lobattoIIIA_a = [| [| 0. ; 0. |] ; [| 0.5 ; 0.5 |] |] ;;


(** *)


let rk2_lobattoIIIA_b = [| 0.5 ; 0.5 |] ;;



let rk4_lobattoIIIA_a = [| [| 0. ; 0. ; 0. |] ; [| 5. /. 24. ; 1. /. 3. ; -1. /. 24. |] ; [| 1. /. 6. ; 2. /. 3. ; 1. /. 6. |] |] ;;


(** The previous method is also quoted as Hermite-Simpson method. *)


let rk4_lobattoIIIA_b = [| 1. /. 6. ; 2. /. 3. ; 1. /. 6. |] ;;



let rk6_lobattoIIIA_b = [| 1. /. 12. ; 5. /. 12. ; 5. /. 12. ; 1. /. 12. |] ;;


(** *)


let rk6_lobattoIIIA_a = [| [| 0. ; 0. ; 0. ; 0. |] ; [| ( 11. +.  sqrt_of_5 ) /. 120. ; ( 25. -.  sqrt_of_5 ) /. 120. ; ( 25. -. 13. *.  sqrt_of_5 ) /. 120. ; ( sqrt_of_5 -. 1. ) /. 120. |] ;

 [| ( 11. -.  sqrt_of_5 ) /. 120. ; ( 25. +. 13. *.  sqrt_of_5 ) /. 120. ; ( 25. +.  sqrt_of_5 ) /. 120. ; ( -1. -. sqrt_of_5 ) /. 120. |] ; rk6_lobattoIIIA_b |] ;;



let rk2_lobattoIIIB_a = [| [| 0.5 ; 0. |] ; [| 0.5 ; 0. |] |] ;;


(** *)


let rk2_lobattoIIIB_b = [| 0.5 ; 0.5 |] ;;



let rk4_lobattoIIIB_a = [| [| 1. /. 6. ; -1. /. 6. ; 0. |] ; [| 1. /. 6. ; 1. /. 3. ; 0. |] ; [| 1. /. 6. ; 5. /. 6. ; 0. |] |] ;;


(** *)


let rk4_lobattoIIIB_b = [| 1. /. 6. ; 2. /. 3. ; 1. /. 6. |] ;;



let rk6_lobattoIIIB_b = rk6_lobattoIIIA_b ;;


(** *)


let rk6_lobattoIIIB_a = [| [| 1. /. 12. ; ( -1. -. sqrt_of_5 ) /. 24. ; ( sqrt_of_5 -. 1. ) /. 24. ; 0. |] ;

 [| 1. /. 12. ; ( 25. +.  sqrt_of_5 ) /. 120. ; ( 25. -. 13. *.  sqrt_of_5 ) /. 120. ; 0. |] ;

 [| 1. /. 12. ; ( 25. +. 13. *.  sqrt_of_5 ) /. 120. ; ( 25. -.  sqrt_of_5 ) /. 120. ; 0. |] ; 

[| 1. /. 12. ; ( 11. -.  sqrt_of_5 ) /. 24. ; ( 11. +.  sqrt_of_5 ) /. 24. ; 0. |] |] ;;



let rk2_lobattoIIIC_a = [| [| 0.5 ; -0.5 |] ; [| 0.5 ; 0.5 |] |] ;;


(** *)


let rk2_lobattoIIIC_b = [| 0.5 ; 0.5 |] ;;



let rk4_lobattoIIIC_a = [| [| 1. /. 6. ; -1. /. 3. ; 1. /. 6. |] ; [| 1. /. 6. ; 5. /. 12. ; -1. /. 12. |] ; [| 1. /. 6. ; 2. /. 3. ; 1. /. 6. |] |] ;;


(** *)


let rk4_lobattoIIIC_b = [| 1. /. 6. ; 2. /. 3. ; 1. /. 6. |] ;;



let rk2_lobattoIIICstar_a = [| [| 0. ; 0. |] ; [| 1. ; 0. |] |] ;;


(** *)


let rk2_lobattoIIICstar_b = [| 0.5 ; 0.5 |] ;;



let rk4_lobattoIIICstar_a = [| [| 0. ; 0. ; 0. |] ; [| 0.25 ; 0.25 ; 0. |] ; [| 0. ; 1. ; 0. |] |] ;;


(** The previous method is also called Lobatto III for s = 3. *)


let rk4_lobattoIIICstar_b = [| 1. /. 6. ; 2. /. 3. ; 1. /. 6. |] ;;



let rk2_lobattoIIID_a = [| [| 0.25 ; -0.25 |] ; [| 0.75 ; 0.25 |] |] ;;


(** *)


let rk2_lobattoIIID_b = [| 0.5 ; 0.5 |] ;;



let rk4_lobattoIIID_a = [| [| 1. /. 12. ; -1. /. 6. ; 1. /. 12. |] ; [| 5. /. 24. ; 1. /. 3. ; -1. /. 24. |] ; [| 1. /. 12. ; 5. /. 6. ; 1. /. 12. |] |] ;;


(** *)


let rk4_lobattoIIID_b = [| 1. /. 6. ; 2. /. 3. ; 1. /. 6. |] ;;



let example_DESIRE_b = [| ( 16. +. sqrt_of_2 ) /. 40. ; ( 16. -. sqrt_of_2 ) /. 40. ; 1. /. 5. |] ;;


(** *)


let example_DESIRE_a = [| [| ( 4. -. sqrt_of_2 ) /. 20. ; ( 4. -. 3. *. sqrt_of_2 ) /. 20. ; 0. |] ;

 [| ( 4. +. 3. *. sqrt_of_2 ) /. 20. ; ( 4. +. sqrt_of_2 ) /. 20. ; 0. |] ; example_DESIRE_b |] ;;










(** 
§ 
 *)



(** 

Méthodes adaptatives explicites


Explicit adaptative methods

*)



(** 
 
 *)











(** 
float_ode_runge_kutta_simple_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let float_ode_runge_kutta_simple_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = ref y0

 and zz = ref 0.

 and error = ref 0.

 and y = Array.make ( nsteps + 1 ) y0 in

  let c = Array.make l 0.

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.make l y0

  and k = Array.make ( l + 1 ) 0. in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

     xx := x.(0) ;

     z := y.( i - 1 ) ;

     k.(0) <- f !xx !z ;

     for j = 0 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      yy.(j) <- !z ;

      let row = a.(j) in

       for index = 0 to j do

        zz := !zz +. row.(index) *. k.(index) ;

       done ;

       yy.(j) <- yy.(j) +. step *. !zz ;

       zz := 0. ;

       k.( j + 1 ) <- f x.(j) yy.(j) ;

     done ;

     x.(0) <- !xx +. step ;

     y.(i) <- !z ;

     for j = 0 to l do

      zz := !zz +. b.(j) *. k.(j) ;

      error := !error +. bb.(j) *. k.(j) ;

     done ;

     if abs_float ( !error ) > tol *. !zz then

      y.(i) <- float_end_ode_runge_kutta a b f nsteps y.( i - 1 ) !xx x.(0)

     else 

      y.(i) <- !z +. step *. !zz ;

     zz := 0. ;

     error := 0. ;

   done ;

   y ;;






(** 
vector_ode_runge_kutta_simple_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let vector_ode_runge_kutta_simple_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and dim = Array.length y0

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning in

  let c = Array.make l 0.

  and dd = dim - 1

  and error = Array.make dim 0.

  and zz = Array.make dim 0.

  and z = Array.make dim 0.

  and y = Array.make_matrix ( nsteps + 1 ) dim 0.

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.make_matrix l dim 0.

  and k = Array.make_matrix ( l + 1 ) dim 0. in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   let row = y.(0) in

    for indice = 0 to dd do

     row.(indice) <- y0.(indice)

    done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    let row = y.( i - 1 ) in

     for indice = 0 to dd do

      z.(indice) <- row.(indice) ;

     done ;

    k.(0) <- f !xx z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     yy.(j) <- z ;

     let row = a.(j) in

      for index = 0 to j do

       let coeff =  row.(index)

       and ligne = k.(index) in

        for indice = 0 to dd do

         zz.(indice) <- zz.(indice) +. coeff *. ligne.(indice) ;

        done ;

      done ;

     let row = yy.(j) in

      for indice = 0 to dd do

       row.(indice) <- row.(indice) +. step *. zz.(indice) ;

       zz.(indice) <- 0. ;

      done ;

     k.( j + 1 ) <- f x.(j) yy.(j) ;

    done ;

    x.(0) <- !xx +. step ;

    y.(i) <- z ;

    for j = 0 to l do

     let row = k.(j)

     and coefficient = bb.(j)

     and coeff = b.(j) in

      for indice = 0 to dd do

       let kk = row.(indice) in

       zz.(indice) <- zz.(indice) +. coeff *. kk ;

       error.(indice) <- error.(indice) +. coefficient *. kk ;

     done ;

    done ;

    if ( Matrix.vector_float_norm_inf error ) > tol *. ( Matrix.vector_float_norm_inf zz ) then

     y.(i) <- vector_end_ode_runge_kutta a b f nsteps y.( i - 1 ) !xx x.(0)

    else 

     let row = y.(i) in

      for indice = 0 to dd do

       row.(indice) <- z.(indice) +. step *. zz.(indice) ;

     done ;

    for indice = 0 to dd do

     zz.(indice) <- 0. ;

     error.(indice) <- 0. ;

    done ;

   done ;

   y ;;






(** 
matrix_ode_runge_kutta_simple_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let matrix_ode_runge_kutta_simple_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and dim_r = Array.length y0

 and dim_c = Array.length y0.(0)

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning in

  let c = Array.make l 0.

  and dd = dim_r - 1

  and cc = dim_c - 1

  and error = Array.make_matrix dim_r dim_c 0.

  and zz = Array.make_matrix dim_r dim_c 0.

  and z = Array.make_matrix dim_r dim_c 0.

  and y = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( nsteps + 1 ) 0. )

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make l 0. )

  and k = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( l + 1 ) 0. ) in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   let row = y.(0) in

    for indice = 0 to dd do

     row.(indice) <- y0.(indice)

    done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    let row = y.( i - 1 ) in

     for indice = 0 to dd do

      z.(indice) <- row.(indice) ;

     done ;

    k.(0) <- f !xx z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     yy.(j) <- z ;

     let row = a.(j) in

      for index = 0 to j do

       let coeff =  row.(index)

       and ligne = k.(index) in

        for indice = 0 to dd do

         zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff ligne.(indice) ) ;

        done ;

      done ;

     let row = yy.(j) in

      for indice = 0 to dd do

       row.(indice) <- Matrix.vector_float_plus row.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

       let ligne = zz.(indice) in

        for numero = 0 to cc do

         ligne.(numero) <- 0. ;

        done ;

      done ;

     k.( j + 1 ) <- f x.(j) yy.(j) ;

    done ;

    x.(0) <- !xx +. step ;

    y.(i) <- z ;

    for j = 0 to l do

     let row = k.(j)

     and coefficient = bb.(j)

     and coeff = b.(j) in

      for indice = 0 to dd do

       let kk = row.(indice) in

       zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff kk ) ;

       error.(indice) <- Matrix.vector_float_plus error.(indice) ( Matrix.vector_float_scal_mult coefficient kk ) ;

     done ;

    done ;

    if ( Matrix.matrix_float_norm_inf error ) > tol *. ( Matrix.matrix_float_norm_inf zz ) then

     y.(i) <- matrix_end_ode_runge_kutta a b f nsteps y.( i - 1 ) !xx x.(0)

    else 

     let row = y.(i) in

      for indice = 0 to dd do

       row.(indice) <- Matrix.vector_float_plus z.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

      done ;

    for indice = 0 to dd do

     let ligne = zz.(indice)

     and row = error.(indice) in

      for numero = 0 to cc do

       ligne.(numero) <- 0. ;

       row.(numero) <- 0. ;

      done ;

    done ;

   done ;

   y ;;








(** 
float_end_ode_runge_kutta_simple_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let float_end_ode_runge_kutta_simple_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = ref y0

 and zz = ref 0.

 and error = ref 0.

 and y = ref y0 in

  let c = Array.make l 0.

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.make l y0

  and k = Array.make ( l + 1 ) 0. in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

     xx := x.(0) ;

     z := !y ;

     k.(0) <- f !xx !z ;

     for j = 0 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      yy.(j) <- !z ;

      let row = a.(j) in

       for index = 0 to j do

        zz := !zz +. row.(index) *. k.(index) ;

       done ;

       yy.(j) <- yy.(j) +. step *. !zz ;

       zz := 0. ;

       k.( j + 1 ) <- f x.(j) yy.(j) ;

     done ;

     x.(0) <- !xx +. step ;

     y := !z ;

     for j = 0 to l do

      zz := !zz +. b.(j) *. k.(j) ;

      error := !error +. bb.(j) *. k.(j) ;

     done ;

     if abs_float ( !error ) > tol *. !zz then

      y := float_end_ode_runge_kutta a b f nsteps !y !xx x.(0)

     else 

      y := !z +. step *. !zz ;

     zz := 0. ;

     error := 0. ;

   done ;

   !y ;;






(** 
vector_end_ode_runge_kutta_simple_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let vector_end_ode_runge_kutta_simple_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and dim = Array.length y0

 and y = Matrix.vector_float_copy y0 in

  let c = Array.make l 0.

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and dd = dim - 1

  and z = Array.make dim 0.

  and zz = Array.make dim 0.

  and error = Array.make dim 0.

  and x = Array.make l beginning

  and yy = Array.make_matrix l dim 0.

  and k = Array.make_matrix ( l + 1 ) dim 0. in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    for indice = 0 to dd do

     z.(indice) <- y.(indice) ;

    done ;

    k.(0) <- f !xx z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     let row = yy.(j) in

      for indice = 0 to dd do

       row.(indice) <- z.(indice) ;

      done ;

     let row = a.(j) in

      for index = 0 to j do

       let coeff = row.(index)

       and ligne = k.(index) in

        for indice = 0 to dd do

         zz.(indice) <- zz.(indice) +. coeff *. ligne.(indice) ;

        done ;

      done ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- row.(indice) +. step *. zz.(indice) ;

        zz.(indice) <- 0. ;

       done ;

       k.( j + 1 ) <- f x.(j) yy.(j) ;

    done ;

    x.(0) <- !xx +. step ;

    for indice = 0 to dd do

     y.(indice) <- z.(indice) ;

    done ;

    for j = 0 to l do

     let ligne = k.(j)

     and coeff = b.(j)

     and coefficient = bb.(j) in

      for indice = 0 to dd do

       let kk = ligne.(indice) in

        zz.(indice) <- zz.(indice) +. coeff *. kk ;

        error.(indice) <- error.(indice) +. coefficient *. kk ;

      done ;

    done ;

     if ( Matrix.vector_float_norm_inf error ) > tol *. ( Matrix.vector_float_norm_inf zz ) then

      let zzz = vector_end_ode_runge_kutta a b f nsteps y !xx x.(0) in

       for indice = 0 to dd do

        y.(indice) <- zzz.(indice) ;

       done ;

     else 

      for indice = 0 to dd do

       y.(indice) <- z.(indice) +. step *. zz.(indice) ;

      done ;

     for indice = 0 to dd do

      zz.(indice) <- 0. ;

      error.(indice) <- 0. ;

     done ;

   done ;

   y ;;






(** 
matrix_end_ode_runge_kutta_simple_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let matrix_end_ode_runge_kutta_simple_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and dim_r = Array.length y0

 and dim_c = Array.length y0.(0)

 and y = Matrix.matrix_float_copy y0 in

  let c = Array.make l 0.

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and dd = dim_r - 1

  and cc = dim_c - 1

  and z = Array.make_matrix dim_r dim_c 0.

  and zz = Array.make_matrix dim_r dim_c 0.

  and error = Array.make_matrix dim_r dim_c 0.

  and x = Array.make l beginning

  and yy = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make l 0. )

  and k = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( l + 1 ) 0. ) in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    for indice = 0 to dd do

     z.(indice) <- y.(indice) ;

    done ;

    k.(0) <- f !xx z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     let row = yy.(j) in

      for indice = 0 to dd do

       row.(indice) <- z.(indice) ;

      done ;

     let row = a.(j) in

      for index = 0 to j do

       let coeff = row.(index)

       and ligne = k.(index) in

        for indice = 0 to dd do

         zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff ligne.(indice) ) ;

        done ;

      done ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- Matrix.vector_float_plus row.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

        let ligne = zz.(indice) in

         for numero = 0 to cc do

          ligne.(numero) <- 0. ;

         done ;

       done ;

       k.( j + 1 ) <- f x.(j) yy.(j) ;

    done ;

    x.(0) <- !xx +. step ;

    for indice = 0 to dd do

     y.(indice) <- z.(indice) ;

    done ;

    for j = 0 to l do

     let ligne = k.(j)

     and coeff = b.(j)

     and coefficient = bb.(j) in

      for indice = 0 to dd do

       let kk = ligne.(indice) in

        zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff kk ) ;

        error.(indice) <- Matrix.vector_float_plus error.(indice) ( Matrix.vector_float_scal_mult coefficient kk ) ;

      done ;

    done ;

     if ( Matrix.matrix_float_norm_inf error ) > tol *. ( Matrix.matrix_float_norm_inf zz ) then

      let zzz = matrix_end_ode_runge_kutta a b f nsteps y !xx x.(0) in

       for indice = 0 to dd do

        y.(indice) <- zzz.(indice) ;

       done ;

     else 

      for indice = 0 to dd do

       y.(indice) <- Matrix.vector_float_plus z.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

      done ;

     for indice = 0 to dd do

      let ligne = zz.(indice)

      and row = error.(indice) in

       for numero = 0 to cc do

        ligne.(numero) <- 0. ;

        row.(numero) <- 0. ;

       done ;

     done ;

   done ;

   y ;;








(** 
float_end_ode_runge_kutta_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let rec float_end_ode_runge_kutta_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = ref y0

 and zz = ref 0.

 and error = ref 0.

 and y = ref y0 in

  let c = Array.make l 0.

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.make l y0

  and k = Array.make ( l + 1 ) 0. in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

     xx := x.(0) ;

     z := !y ;

     k.(0) <- f !xx !z ;

     for j = 0 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      yy.(j) <- !z ;

      let row = a.(j) in

       for index = 0 to j do

        zz := !zz +. row.(index) *. k.(index) ;

       done ;

       yy.(j) <- yy.(j) +. step *. !zz ;

       zz := 0. ;

       k.( j + 1 ) <- f x.(j) yy.(j) ;

     done ;

     x.(0) <- !xx +. step ;

     y := !z ;

     for j = 0 to l do

      zz := !zz +. b.(j) *. k.(j) ;

      error := !error +. bb.(j) *. k.(j) ;

     done ;

     if abs_float ( !error ) > tol *. !zz then

      y := float_end_ode_runge_kutta a b f nsteps !y !xx x.(0)

     else y := !z +. step *. !zz ;

     zz := 0. ;

     error := 0. ;

   done ;

   !y ;;






(** 
vector_end_ode_runge_kutta_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let rec vector_end_ode_runge_kutta_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and dim = Array.length y0

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and y = Matrix.vector_float_copy y0 in

  let c = Array.make l 0.

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and dd = dim - 1

  and x = Array.make l beginning

  and z = Array.make dim 0.

  and zz = Array.make dim 0.

  and error = Array.make dim 0.

  and yy = Array.make_matrix l dim 0.

  and k = Array.make_matrix ( l + 1 ) dim 0. in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    for indice = 0 to dd do

     z.(indice) <- y.(indice) ;

    done ;

    k.(0) <- f !xx z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     let row = yy.(j) in

      for indice = 0 to dd do

       row.(indice) <- z.(indice) ;

      done ;

      let row = a.(j) in

       for index = 0 to j do

        let coeff = row.(index)

        and ligne = k.(index) in

         for indice = 0 to dd do

          zz.(indice) <- zz.(indice) +. coeff *. ligne.(indice) ;

         done ;

       done ;

       let row = yy.(j) in

        for indice = 0 to dd do

         row.(indice) <- row.(indice) +. step *. zz.(indice) ;

         zz.(indice) <- 0. ;

        done ;

       k.( j + 1 ) <- f x.(j) yy.(j) ;

     done ;

     x.(0) <- !xx +. step ;

     for indice = 0 to dd do

      y.(indice) <- z.(indice) ;

     done ;

     for j = 0 to l do

      let ligne = k.(j)

      and coeff = b.(j)

      and coefficient = bb.(j) in

       for indice = 0 to dd do

        zz.(indice) <- zz.(indice) +. coeff *. ligne.(indice) ;

        error.(indice) <- error.(indice) +. coefficient *. ligne.(indice) ;

       done ;

     done ;

     if ( Matrix.vector_float_norm_inf error ) > tol *. ( Matrix.vector_float_norm_inf zz ) then

      let yyy = vector_end_ode_runge_kutta a b f nsteps y !xx x.(0) in

       for indice = 0 to dd do

        y.(indice) <- yyy.(indice)

       done ;

     else

      for indice = 0 to dd do

       y.(indice) <- z.(indice) +. step *. zz.(indice) ;

      done ;

     for indice = 0 to dd do

      zz.(indice) <- 0. ;

      error.(indice) <- 0. ;

     done ;

   done ;

   y ;;






(** 
matrix_end_ode_runge_kutta_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let rec matrix_end_ode_runge_kutta_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and dim_r = Array.length y0

 and dim_c = Array.length y0.(0)

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and y = Matrix.matrix_float_copy y0 in

  let c = Array.make l 0.

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and dd = dim_r - 1

  and cc = dim_c - 1

  and x = Array.make l beginning

  and z = Array.make_matrix dim_r dim_c 0.

  and zz = Array.make_matrix dim_r dim_c 0.

  and error = Array.make_matrix dim_r dim_c 0.

  and yy = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make l 0. )

  and k = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( l + 1 ) 0. ) in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    for indice = 0 to dd do

     z.(indice) <- y.(indice) ;

    done ;

    k.(0) <- f !xx z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     let row = yy.(j) in

      for indice = 0 to dd do

       row.(indice) <- z.(indice) ;

      done ;

      let row = a.(j) in

       for index = 0 to j do

        let coeff = row.(index)

        and ligne = k.(index) in

         for indice = 0 to dd do

          zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff ligne.(indice) ) ;

         done ;

       done ;

       let row = yy.(j) in

        for indice = 0 to dd do

         row.(indice) <- Matrix.vector_float_plus row.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

         let ligne = zz.(indice) in

          for numero = 0 to cc do

           ligne.(numero) <- 0. ;

          done ;

        done ;

       k.( j + 1 ) <- f x.(j) yy.(j) ;

     done ;

     x.(0) <- !xx +. step ;

     for indice = 0 to dd do

      y.(indice) <- z.(indice) ;

     done ;

     for j = 0 to l do

      let ligne = k.(j)

      and coeff = b.(j)

      and coefficient = bb.(j) in

       for indice = 0 to dd do

        zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff ligne.(indice) ) ;

        error.(indice) <- Matrix.vector_float_plus error.(indice) ( Matrix.vector_float_scal_mult coefficient ligne.(indice) ) ;

       done ;

     done ;

     if ( Matrix.matrix_float_norm_inf error ) > tol *. ( Matrix.matrix_float_norm_inf zz ) then

      let yyy = matrix_end_ode_runge_kutta a b f nsteps y !xx x.(0) in

       for indice = 0 to dd do

        y.(indice) <- yyy.(indice)

       done ;

     else

      for indice = 0 to dd do

       y.(indice) <- Matrix.vector_float_plus z.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

      done ;

     for indice = 0 to dd do

      let ligne = zz.(indice)

      and row = error.(indice) in

       for numero = 0 to cc do

        ligne.(numero) <- 0. ;

        row.(numero) <- 0. ;

       done ;

     done ;

   done ;

   y ;;








(** 
float_end_ode_runge_kutta_bounded maxstages butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let rec float_end_ode_runge_kutta_bounded = fun (maxstages:int) (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> float_end_ode_runge_kutta_simple_adapt a b bstar tol f nsteps y0 beginning ending

 | _ -> 

  let l = Array.length a

  and step = ( ending -. beginning ) /. ( float nsteps )

  and xx = ref beginning

  and z = ref y0

  and zz = ref 0.

  and error = ref 0.

  and y = ref y0 in

   let c = Array.make l 0.

   and bb = Array.make ( l + 1 ) 0.

   and ll = l - 1

   and x = Array.make l beginning

   and yy = Array.make l y0

   and k = Array.make ( l + 1 ) 0. in

    bb.(l) <- b.(l) -. bstar.(l) ;

    for i = 0 to ll do

     bb.(i) <- b.(i) -. bstar.(i) ;

     let row = a.(i) in

      for j = 0 to i do

       c.(i) <- c.(i) +. row.(j) ;

      done ;

    done ;

    for i = 1 to nsteps do

      xx := x.(0) ;

      z := !y ;

      k.(0) <- f !xx !z ;

      for j = 0 to ll do

       x.(j) <- !xx +. step *. c.(j) ;

       yy.(j) <- !z ;

       let row = a.(j) in

        for index = 0 to j do

         zz := !zz +. row.(index) *. k.(index) ;

        done ;

        yy.(j) <- yy.(j) +. step *. !zz ;

        zz := 0. ;

        k.( j + 1 ) <- f x.(j) yy.(j) ;

      done ;

      x.(0) <- !xx +. step ;

      y := !z ;

      for j = 0 to l do

       zz := !zz +. b.(j) *. k.(j) ;

       error := !error +. bb.(j) *. k.(j) ;

      done ;

      if abs_float ( !error ) > tol *. !zz then

       y := float_end_ode_runge_kutta_bounded ( ( abs maxstages ) - 1 ) a b bstar tol f nsteps !y !xx x.(0)

      else y := !z +. step *. !zz ;

      zz := 0. ;

      error := 0. ;

    done ;

    !y ;;






(** 
vector_end_ode_runge_kutta_bounded maxstages butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let rec vector_end_ode_runge_kutta_bounded = fun (maxstages:int) (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> vector_end_ode_runge_kutta_simple_adapt a b bstar tol f nsteps y0 beginning ending

 | _ -> 

  let l = Array.length a

  and dim = Array.length y0

  and step = ( ending -. beginning ) /. ( float nsteps )

  and xx = ref beginning

  and y = Matrix.vector_float_copy y0 in

   let c = Array.make l 0.

   and bb = Array.make ( l + 1 ) 0.

   and ll = l - 1

   and dd = dim - 1

   and x = Array.make l beginning

   and z = Array.make dim 0.

   and zz = Array.make dim 0.

   and error = Array.make dim 0.

   and yy = Array.make_matrix l dim 0.

   and k = Array.make_matrix ( l + 1 ) dim 0. in

    bb.(l) <- b.(l) -. bstar.(l) ;

    for i = 0 to ll do

     bb.(i) <- b.(i) -. bstar.(i) ;

     let row = a.(i) in

      for j = 0 to i do

       c.(i) <- c.(i) +. row.(j) ;

      done ;

    done ;

    for i = 1 to nsteps do

     xx := x.(0) ;

     for indice = 0 to dd do

      z.(indice) <- y.(indice) ;

     done ;

     k.(0) <- f !xx z ;

     for j = 0 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- z.(indice) ;

       done ;

      let row = a.(j) in

       for index = 0 to j do

        let coeff = row.(index)

        and ligne = k.(index) in

         for indice = 0 to dd do

          zz.(indice) <- zz.(indice) +. coeff *. ligne.(indice) ;

         done ;

        done ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- row.(indice) +. step *. zz.(indice) ;

        zz.(indice) <- 0. ;

       done ;

      k.( j + 1 ) <- f x.(j) yy.(j) ;

     done ;

     x.(0) <- !xx +. step ;

     for indice = 0 to dd do

      y.(indice) <- z.(indice) ;

     done ;

     for j = 0 to l do

      let coeff = b.(j)

      and coefficient = bb.(j)

      and ligne = k.(j) in

      for indice = 0 to dd do

       zz.(indice) <- zz.(indice) +. coeff *. ligne.(indice) ;

       error.(indice) <- error.(indice) +. coefficient *. ligne.(indice) ;

      done ;

     done ;

     if ( Matrix.vector_float_norm_inf error ) > tol *. ( Matrix.vector_float_norm_inf zz ) then

      let yyy = vector_end_ode_runge_kutta_bounded ( ( abs maxstages ) - 1 ) a b bstar tol f nsteps y !xx x.(0) in

       for indice = 0 to dd do

        y.(indice) <- yyy.(indice) ;

       done ;

     else

       for indice = 0 to dd do

        y.(indice) <- z.(indice) +. step *. zz.(indice) ;

       done ;

     for indice = 0 to dd do

      zz.(indice) <- 0. ;

      error.(indice) <- 0. ;

     done ;

    done ;

    y ;;






(** 
matrix_end_ode_runge_kutta_bounded maxstages butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let rec matrix_end_ode_runge_kutta_bounded = fun (maxstages:int) (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> matrix_end_ode_runge_kutta_simple_adapt a b bstar tol f nsteps y0 beginning ending

 | _ -> 

  let l = Array.length a

  and dim_r = Array.length y0

  and dim_c = Array.length y0.(0)

  and step = ( ending -. beginning ) /. ( float nsteps )

  and xx = ref beginning

  and y = Matrix.matrix_float_copy y0 in

   let c = Array.make l 0.

   and bb = Array.make ( l + 1 ) 0.

   and ll = l - 1

   and dd = dim_r - 1

   and cc = dim_c - 1

   and x = Array.make l beginning

   and z = Array.make_matrix dim_r dim_c 0.

   and zz = Array.make_matrix dim_r dim_c 0.

   and error = Array.make_matrix dim_r dim_c 0.

   and yy = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make l 0. )

   and k = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( l + 1 ) 0. ) in

    bb.(l) <- b.(l) -. bstar.(l) ;

    for i = 0 to ll do

     bb.(i) <- b.(i) -. bstar.(i) ;

     let row = a.(i) in

      for j = 0 to i do

       c.(i) <- c.(i) +. row.(j) ;

      done ;

    done ;

    for i = 1 to nsteps do

     xx := x.(0) ;

     for indice = 0 to dd do

      z.(indice) <- y.(indice) ;

     done ;

     k.(0) <- f !xx z ;

     for j = 0 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- z.(indice) ;

       done ;

      let row = a.(j) in

       for index = 0 to j do

        let coeff = row.(index)

        and ligne = k.(index) in

         for indice = 0 to dd do

          zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff ligne.(indice) ) ;

         done ;

        done ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- Matrix.vector_float_plus row.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

        let ligne = zz.(indice) in

         for numero = 0 to cc do

          ligne.(numero) <- 0. ;

         done ;

       done ;

      k.( j + 1 ) <- f x.(j) yy.(j) ;

     done ;

     x.(0) <- !xx +. step ;

     for indice = 0 to dd do

      y.(indice) <- z.(indice) ;

     done ;

     for j = 0 to l do

      let coeff = b.(j)

      and coefficient = bb.(j)

      and ligne = k.(j) in

      for indice = 0 to dd do

       zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff ligne.(indice) ) ;

       error.(indice) <- Matrix.vector_float_plus error.(indice) ( Matrix.vector_float_scal_mult coefficient ligne.(indice) ) ;

      done ;

     done ;

     if ( Matrix.matrix_float_norm_inf error ) > tol *. ( Matrix.matrix_float_norm_inf zz ) then

      let yyy = matrix_end_ode_runge_kutta_bounded ( ( abs maxstages ) - 1 ) a b bstar tol f nsteps y !xx x.(0) in

       for indice = 0 to dd do

        y.(indice) <- yyy.(indice) ;

       done ;

     else

      for indice = 0 to dd do

       y.(indice) <- Matrix.vector_float_plus z.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

      done ;

     for indice = 0 to dd do

      let ligne = zz.(indice)

      and row = error.(indice) in

       for numero = 0 to cc do

        ligne.(numero) <- 0. ;

        row.(numero) <- 0. ;

       done ;

     done ;

    done ;

    y ;;








(** 
float_ode_runge_kutta_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let float_ode_runge_kutta_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let l = Array.length a

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning

 and z = ref y0

 and zz = ref 0.

 and error = ref 0.

 and y = Array.make ( nsteps + 1 ) y0 in

  let c = Array.make l 0.

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and x = Array.make l beginning

  and yy = Array.make l y0

  and k = Array.make ( l + 1 ) 0. in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    z := y.( i - 1 ) ;

    k.(0) <- f !xx !z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     yy.(j) <- !z ;

     let row = a.(j) in

      for index = 0 to j do

       zz := !zz +. row.(index) *. k.(index) ;

      done ;

      yy.(j) <- yy.(j) +. step *. !zz ;

      zz := 0. ;

      k.( j + 1 ) <- f x.(j) yy.(j) ;

    done ;

    x.(0) <- !xx +. step ;

    y.(i) <- !z ;

    for j = 0 to l do

     zz := !zz +. b.(j) *. k.(j) ;

     error := !error +. bb.(j) *. k.(j) ;

    done ;

    if abs_float ( !error ) > tol *. !zz then

     y.(i) <- float_end_ode_runge_kutta_adapt a b bstar tol f nsteps y.( i - 1 ) !xx x.(0)

    else y.(i) <- !z +. step *. !zz ;

    zz := 0. ;

    error := 0. ;

  done ;

  y ;;






(** 
vector_ode_runge_kutta_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let vector_ode_runge_kutta_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and dim = Array.length y0

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning in

  let c = Array.make l 0.

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and dd = dim - 1

  and x = Array.make l beginning

  and z = Array.make dim 0.

  and zz = Array.make dim 0.

  and error = Array.make dim 0.

  and y = Array.make_matrix ( nsteps + 1 ) dim 0.

  and yy = Array.make_matrix l dim 0.

  and k = Array.make_matrix ( l + 1 ) dim 0. in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   let row = y.(0) in

    for indice = 0 to dd do

     row.(indice) <- y0.(indice) ;

    done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    let row = y.( i - 1 ) in

     for indice = 0 to dd do

      z.(indice) <- row.(indice) ;

     done ;

    k.(0) <- f !xx z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     let row = yy.(j) in

      for indice = 0 to dd do

       row.(indice) <- z.(indice) ;

      done ;

     let row = a.(j) in

      for index = 0 to j do

       let coeff = row.(index)

       and ligne = k.(index) in

        for indice = 0 to dd do

         zz.(indice) <- zz.(indice) +. coeff *. ligne.(indice) ;

        done ;

      done ;

     let row = yy.(j) in

      for indice = 0 to dd do

       row.(indice) <- row.(indice) +. step *. zz.(indice) ;

       zz.(indice) <- 0.

      done ;

     k.( j + 1 ) <- f x.(j) yy.(j) ;

    done ;

    x.(0) <- !xx +. step ;

    let row = y.(i) in

     for indice = 0 to dd do

      row.(indice) <- z.(indice) ;

     done ;

    for j = 0 to l do

     let ligne = k.(j)

     and coeff = b.(j)

     and coefficient = bb.(j) in

      for indice = 0 to dd do

       zz.(indice) <- zz.(indice) +. coeff *. ligne.(indice) ;

       error.(indice) <- error.(indice) +. coefficient *. ligne.(indice) ;

      done ;

    done ;

    if ( Matrix.vector_float_norm_inf error ) > tol *. ( Matrix.vector_float_norm_inf zz ) then

     let yyy = vector_end_ode_runge_kutta_adapt a b bstar tol f nsteps y.( i - 1 ) !xx x.(0)

     and row = y.(i) in

      for indice = 0 to dd do

       row.(indice) <- yyy.(indice) ;

      done ;

    else

     let row = y.(i) in

      for indice = 0 to dd do

       row.(indice) <- z.(indice) +. step *. zz.(indice) ;

      done ;

    for indice = 0 to dd do

     zz.(indice) <- 0. ;

     error.(indice) <- 0. ;

    done ;

   done ;

   y ;;






(** 
matrix_ode_runge_kutta_adapt butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let matrix_ode_runge_kutta_adapt = fun (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let l = Array.length a

 and dim_r = Array.length y0

 and dim_c = Array.length y0.(0)

 and step = ( ending -. beginning ) /. ( float nsteps )

 and xx = ref beginning in

  let c = Array.make l 0.

  and bb = Array.make ( l + 1 ) 0.

  and ll = l - 1

  and dd = dim_r - 1

  and cc = dim_c - 1

  and x = Array.make l beginning

  and z = Array.make_matrix dim_r dim_c 0.

  and zz = Array.make_matrix dim_r dim_c 0.

  and error = Array.make_matrix dim_r dim_c 0.

  and y = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( nsteps + 1 ) 0. )

  and yy = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make l 0. )

  and k = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( l + 1 ) 0. ) in

   bb.(l) <- b.(l) -. bstar.(l) ;

   for i = 0 to ll do

    bb.(i) <- b.(i) -. bstar.(i) ;

    let row = a.(i) in

     for j = 0 to i do

      c.(i) <- c.(i) +. row.(j) ;

     done ;

   done ;

   let row = y.(0) in

    for indice = 0 to dd do

     row.(indice) <- y0.(indice) ;

    done ;

   for i = 1 to nsteps do

    xx := x.(0) ;

    let row = y.( i - 1 ) in

     for indice = 0 to dd do

      z.(indice) <- row.(indice) ;

     done ;

    k.(0) <- f !xx z ;

    for j = 0 to ll do

     x.(j) <- !xx +. step *. c.(j) ;

     let row = yy.(j) in

      for indice = 0 to dd do

       row.(indice) <- z.(indice) ;

      done ;

     let row = a.(j) in

      for index = 0 to j do

       let coeff = row.(index)

       and ligne = k.(index) in

        for indice = 0 to dd do

         zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff ligne.(indice) ) ;

        done ;

      done ;

     let row = yy.(j) in

      for indice = 0 to dd do

       row.(indice) <- Matrix.vector_float_plus row.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

       let ligne = zz.(indice) in

        for numero = 0 to cc do

         ligne.(numero) <- 0. ;

        done ;

      done ;

     k.( j + 1 ) <- f x.(j) yy.(j) ;

    done ;

    x.(0) <- !xx +. step ;

    let row = y.(i) in

     for indice = 0 to dd do

      row.(indice) <- z.(indice) ;

     done ;

    for j = 0 to l do

     let ligne = k.(j)

     and coeff = b.(j)

     and coefficient = bb.(j) in

      for indice = 0 to dd do

       zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff ligne.(indice) ) ;

       error.(indice) <- Matrix.vector_float_plus error.(indice) ( Matrix.vector_float_scal_mult coefficient ligne.(indice) ) ;

      done ;

    done ;

    if ( Matrix.matrix_float_norm_inf error ) > tol *. ( Matrix.matrix_float_norm_inf zz ) then

     let yyy = matrix_end_ode_runge_kutta_adapt a b bstar tol f nsteps y.( i - 1 ) !xx x.(0)

     and row = y.(i) in

      for indice = 0 to dd do

       row.(indice) <- yyy.(indice) ;

      done ;

    else

     let row = y.(i) in

      for indice = 0 to dd do

       row.(indice) <- Matrix.vector_float_plus z.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

      done ;

    for indice = 0 to dd do

     let ligne = zz.(indice)

     and row = error.(indice) in

      for numero = 0 to cc do

       ligne.(numero) <- 0. ;

       row.(numero) <- 0. ;

      done ;

    done ;

   done ;

   y ;;








(** 
float_ode_runge_kutta_bounded maxstages butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let float_ode_runge_kutta_bounded = fun (maxstages:int) (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> float_ode_runge_kutta_simple_adapt a b bstar tol f nsteps y0 beginning ending

 | _ -> 

  let l = Array.length a

  and step = ( ending -. beginning ) /. ( float nsteps )

  and xx = ref beginning

  and z = ref y0

  and zz = ref 0.

  and error = ref 0.

  and y = Array.make ( nsteps + 1 ) y0 in

   let c = Array.make l 0.

   and bb = Array.make ( l + 1 ) 0.

   and ll = l - 1

   and x = Array.make l beginning

   and yy = Array.make l y0

   and k = Array.make ( l + 1 ) 0. in

    bb.(l) <- b.(l) -. bstar.(l) ;

    for i = 0 to ll do

     bb.(i) <- b.(i) -. bstar.(i) ;

     let row = a.(i) in

      for j = 0 to i do

       c.(i) <- c.(i) +. row.(j) ;

      done ;

    done ;

    for i = 1 to nsteps do

     xx := x.(0) ;

     z := y.( i - 1 ) ;

     k.(0) <- f !xx !z ;

     for j = 0 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      yy.(j) <- !z ;

      let row = a.(j) in

       for index = 0 to j do

        zz := !zz +. row.(index) *. k.(index) ;

       done ;

       yy.(j) <- yy.(j) +. step *. !zz ;

       zz := 0. ;

       k.( j + 1 ) <- f x.(j) yy.(j) ;

     done ;

     x.(0) <- !xx +. step ;

     y.(i) <- !z ;

     for j = 0 to l do

      zz := !zz +. b.(j) *. k.(j) ;

      error := !error +. bb.(j) *. k.(j) ;

     done ;

     if abs_float ( !error ) > tol *. !zz then

      y.(i) <- float_end_ode_runge_kutta_bounded ( ( abs maxstages ) - 1 ) a b bstar tol f nsteps y.( i - 1 ) !xx x.(0)

     else y.(i) <- !z +. step *. !zz ;

     zz := 0. ;

     error := 0. ;

   done ;

   y ;;






(** 
vector_ode_runge_kutta_bounded maxstages butcher_matrix butcher_vector_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let vector_ode_runge_kutta_bounded = fun (maxstages:int) (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> vector_ode_runge_kutta_simple_adapt a b bstar tol f nsteps y0 beginning ending

 | _ -> 

  let l = Array.length a

  and dim = Array.length y0

  and step = ( ending -. beginning ) /. ( float nsteps )

  and xx = ref beginning in

   let c = Array.make l 0.

   and bb = Array.make ( l + 1 ) 0.

   and ll = l - 1

   and dd = dim - 1

   and x = Array.make l beginning

   and z = Array.make dim 0.

   and zz = Array.make dim 0.

   and error = Array.make dim 0.

   and y = Array.make_matrix ( nsteps + 1 ) dim 0.

   and yy = Array.make_matrix l dim 0.

   and k = Array.make_matrix ( l + 1 ) dim 0. in

    bb.(l) <- b.(l) -. bstar.(l) ;

    for i = 0 to ll do

     bb.(i) <- b.(i) -. bstar.(i) ;

     let row = a.(i) in

      for j = 0 to i do

       c.(i) <- c.(i) +. row.(j) ;

      done ;

    done ;

    let row = y.(0) in

     for indice = 0 to dd do

      row.(indice) <- y0.(indice) ;

     done ;

    for i = 1 to nsteps do

     xx := x.(0) ;

     let row = y.( i - 1 ) in

      for indice = 0 to dd do

       z.(indice) <- row.(indice) ;

      done ;

     k.(0) <- f !xx z ;

     for j = 0 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- z.(indice) ;

       done ;

      let row = a.(j) in

       for index = 0 to j do

        let ligne = k.(index)

        and coeff = row.(index) in

         for indice = 0 to dd do

          zz.(indice) <- zz.(indice) +. coeff *. ligne.(indice) ;

         done ;

       done ;

       let row = yy.(j) in

        for indice = 0 to dd do

         row.(indice) <- row.(indice) +. step *. zz.(indice) ;

         zz.(indice) <- 0. ;

        done ;

       k.( j + 1 ) <- f x.(j) yy.(j) ;

     done ;

     x.(0) <- !xx +. step ;

     let row = y.(i) in

      for indice = 0 to dd do

       row.(indice) <- z.(indice) ;

      done ;

     for j = 0 to l do

      let ligne = k.(j)

      and coeff = b.(j)

      and coefficient = bb.(j) in

       for indice = 0 to dd do

        let kk = ligne.(indice) in

         zz.(indice) <- zz.(indice) +. coeff *. kk ;

         error.(indice) <- error.(indice) +. coefficient *. kk ;

       done ;

     done ;

     if ( Matrix.vector_float_norm_inf error ) > tol *. ( Matrix.vector_float_norm_inf zz ) then

      let yyy = vector_end_ode_runge_kutta_bounded ( ( abs maxstages ) - 1 ) a b bstar tol f nsteps y.( i - 1 ) !xx x.(0)

      and row = y.(i) in

       for indice = 0 to dd do

        row.(indice) <- yyy.(indice) ;

       done ;

     else

      let row = y.(i) in

       for indice = 0 to dd do

        row.(indice) <- z.(indice) +. step *. zz.(indice) ;

       done ;

     for indice = 0 to dd do

      zz.(indice) <- 0. ;

      error.(indice) <- 0. ;

     done ;

   done ;

   y ;;






(** 
matrix_ode_runge_kutta_bounded maxstages butcher_matrix butcher_matrix_fine butcher_vector_raw tolerance function nsteps value beginning ending
 *)


let matrix_ode_runge_kutta_bounded = fun (maxstages:int) (a:float array array) (b:float array) (bstar:float array) (tol:float) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> matrix_ode_runge_kutta_simple_adapt a b bstar tol f nsteps y0 beginning ending

 | _ -> 

  let l = Array.length a

  and dim_r = Array.length y0

  and dim_c = Array.length y0.(0)

  and step = ( ending -. beginning ) /. ( float nsteps )

  and xx = ref beginning in

   let c = Array.make l 0.

   and bb = Array.make ( l + 1 ) 0.

   and ll = l - 1

   and dd = dim_r - 1

   and cc = dim_c - 1

   and x = Array.make l beginning

   and z = Array.make_matrix dim_r dim_c 0.

   and zz = Array.make_matrix dim_r dim_c 0.

   and error = Array.make_matrix dim_r dim_c 0.

   and y = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( nsteps + 1 ) 0. )

   and yy = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make l 0. )

   and k = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( l + 1 ) 0. ) in

    bb.(l) <- b.(l) -. bstar.(l) ;

    for i = 0 to ll do

     bb.(i) <- b.(i) -. bstar.(i) ;

     let row = a.(i) in

      for j = 0 to i do

       c.(i) <- c.(i) +. row.(j) ;

      done ;

    done ;

    let row = y.(0) in

     for indice = 0 to dd do

      row.(indice) <- y0.(indice) ;

     done ;

    for i = 1 to nsteps do

     xx := x.(0) ;

     let row = y.( i - 1 ) in

      for indice = 0 to dd do

       z.(indice) <- row.(indice) ;

      done ;

     k.(0) <- f !xx z ;

     for j = 0 to ll do

      x.(j) <- !xx +. step *. c.(j) ;

      let row = yy.(j) in

       for indice = 0 to dd do

        row.(indice) <- z.(indice) ;

       done ;

      let row = a.(j) in

       for index = 0 to j do

        let ligne = k.(index)

        and coeff = row.(index) in

         for indice = 0 to dd do

          zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff ligne.(indice) ) ;

         done ;

       done ;

       let row = yy.(j) in

        for indice = 0 to dd do

         row.(indice) <- Matrix.vector_float_plus row.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

         let ligne = zz.(indice) in

          for numero = 0 to cc do

           ligne.(numero) <- 0. ;

          done ;

        done ;

       k.( j + 1 ) <- f x.(j) yy.(j) ;

     done ;

     x.(0) <- !xx +. step ;

     let row = y.(i) in

      for indice = 0 to dd do

       row.(indice) <- z.(indice) ;

      done ;

     for j = 0 to l do

      let ligne = k.(j)

      and coeff = b.(j)

      and coefficient = bb.(j) in

       for indice = 0 to dd do

        let kk = ligne.(indice) in

         zz.(indice) <- Matrix.vector_float_plus zz.(indice) ( Matrix.vector_float_scal_mult coeff kk ) ;

         error.(indice) <- Matrix.vector_float_plus error.(indice) ( Matrix.vector_float_scal_mult coefficient kk ) ;

       done ;

     done ;

     if ( Matrix.matrix_float_norm_inf error ) > tol *. ( Matrix.matrix_float_norm_inf zz ) then

      let yyy = matrix_end_ode_runge_kutta_bounded ( ( abs maxstages ) - 1 ) a b bstar tol f nsteps y.( i - 1 ) !xx x.(0)

      and row = y.(i) in

       for indice = 0 to dd do

        row.(indice) <- yyy.(indice) ;

       done ;

     else

      let row = y.(i) in

       for indice = 0 to dd do

        row.(indice) <- Matrix.vector_float_plus z.(indice) ( Matrix.vector_float_scal_mult step zz.(indice) ) ;

       done ;

     for indice = 0 to dd do

      let ligne = zz.(indice)

      and row = error.(indice) in

       for numero = 0 to cc do

        ligne.(numero) <- 0. ;

        row.(numero) <- 0. ;

       done ;

     done ;

   done ;

   y ;;








(** 
§ 
 *)









(** Some Butcher tableaus are following. They have been harvested on the internet.



Suivent quelques tableaux de Butcher. Ils ont été glanés sur internet. 




 
 *)




let rk2_a = [| [| 1. |] |] ;;

let rk2_b_fine = [| 0.5 ; 0.5 |] ;;


(** *)


let rk2_b_raw = [| 1. ; 0. |] ;;



let rkf_2_3_a = [| [| 1. |] ; [| 0.25 ; 0.25 |] |] ;;

let rkf_2_3_b_fine = [| 1. /. 6. ; 1. /. 6. ; 2. /. 3. |] ;;


(** *)


let rkf_2_3_b_raw = [| 0.5 ; 0.5 ; 0. |] ;;



let bogacki_shampine_a = [| [| 0.5 |] ; [| 0. ; 0.75 |] ; [| 2. /. 9. ; 1. /. 3. ; 4. /. 9. |] |] ;;

let bogacki_shampine_b_raw = [| 2. /. 9. ; 1. /. 3. ; 4. /. 9. ; 0. |] ;;


(** *)


let bogacki_shampine_b_fine = [| 7. /. 24. ; 0.25 ; 1. /. 3. ; 0.125 |] ;;



let rk4_bogacki_shampine_a = [| [| 1.0 /. 6.0 |] ; [| 2.0 /. 27.0 ; 4.0 /. 27.0 |] ; [| 183.0 /. 1372.0 ; -162.0 /. 343.0 ; 1053.0 /. 1372.0 |] ;

 [| 68.0 /. 297.0 ; -4.0 /. 11.0 ; 42.0 /. 143.0 ; 1960.0 /. 3861.0 |] ;

 [| 597.0 /. 22528.0 ; 81.0 /. 352.0 ; 63099.0 /. 585728.0 ; 58653.0 /. 366080.0 ; 4617.0 /. 20480.0 |] ;

 [| 174197.0 /. 959244.0 ; -30942.0 /. 79937.0 ; 8152137.0 /. 19744439.0 ; 666106.0 /. 1039181.0 ; -29421.0 /. 29068.0 ; 482048.0 /. 414219.0 |] ;

 [| 587.0 /. 8064.0 ; 0.0 ; 4440339.0 /. 15491840.0 ; 24353.0 /. 124800.0 ; 387.0 /. 44800.0 ; 2152.0 /. 5985.0 ; 7267.0 /. 94080.0 |] |] ;;

let rk4_bogacki_shampine_b_fine = [| 2479.0 /. 34992.0 ; 0.0 ; 123.0 /. 416.0 ; 612941.0 /. 3411720.0 ; 43.0 /. 1440.0 ; 2272.0 /. 6561.0 ; 79937.0 /. 1113912.0 ; 3293.0 /. 556956.0 |] ;;

let rk4_bogacki_shampine_b_err = [| -3.0 /. 1280.0 ; 0.0 ; 6561.0 /. 632320.0 ; -343.0 /. 20800.0 ; 243.0 /. 12800.0 ; -1.0 /. 95.0 ; 0.0 |] ;;


(** *)


let rk4_bogacki_shampine_b_raw = Matrix.vector_float_plus rk4_bogacki_shampine_b_err rk4_bogacki_shampine_b_fine ;;



let dormand_prince_4_5_a = [| [| 0.2 |] ; [| 0.075 ; 0.225 |] ; [| 44. /. 45. ;  -56. /. 15. ; 32. /. 9. |] ;

 [| 19372. /. 6561. ; -25360. /. 2187. ; 64448. /. 6561. ; -212. /. 729. ; |] ;

 [| 9017. /. 3168. ; -355. /. 33. ; 46732. /. 5247. ; 49. /. 176. ; -5103. /. 18656. |] ;

 [| 35. /. 384. ; 0. ; 500. /. 1113. ; 125. /. 192. ; -2187. /. 6784. ; 11. /. 84. |] |] ;;

let dormand_prince_4_5_b_raw = [| 5179. /. 57600. ; 0. ; 7571. /. 16695. ; 0.6140625 ; -92097. /. 339200. ; 187. /. 2100. ; 0.025 |] ;;


(** *)


let dormand_prince_4_5_b_fine = [| 35. /. 384. ; 0. ; 500. /. 1113. ; 125. /. 192. ; -2187. /. 6784. ; 11. /. 84. ; 0. |] ;;



let runge_kutta_fehlberg_a = [| [| 0.25 |] ; [| 3. /. 32. ; 9. /. 32. |] ;

 [| 1932. /. 2197. ; -7200. /. 2197. ;  7296. /. 2197. |] ; [| 439. /. 216. ; -8. ; 3680. /. 513. ; -845. /. 4104. |] ;

 [| -8. /. 27. ; 2. ; -3544. /. 2565. ; -1859. /. 4104. ; -0.275 |] |] ;;

let runge_kutta_fehlberg_b_fine = [| 16. /. 135. ; 0. ; 6656. /. 12825. ; 28561. /. 56430. ; -0.18 ; 2. /. 55. |] ;;


(** *)


let runge_kutta_fehlberg_b_raw = [| 25. /. 216. ; 0. ; 1408. /. 2565. ; 2197. /. 4104. ; -0.2 ; 0. |] ;;



let cash_karp_a = [| [| 0.2 |] ; [| 0.075 ; 0.225 |] ; [| 0.3 ; -0.9 ; 1.2 |] ;

 [| -11. /. 54. ; 2.5 ; -70. /. 27. ; 35. /. 27. |] ;

 [| 1631. /. 55296. ; 0.341796875 ; 575. /. 13824. ; 44275. /. 110592. ; 0.061767578125 |] |] ;;

let cash_karp_b_fine = [| 37. /. 378. ; 0. ; 250. /. 621. ; 125. /. 594. ; 0. ;  512. /. 1771. |]


(** *)


let cash_karp_b_raw = [| 2825. /. 27648. ; 0. ; 18575. /. 48384. ; 13525. /. 55296. ; 277. /. 14336. ; 0.25 |] ;;



let hem_5_3_a = [| [| 0.1 |] ;

[| 0.375e-1 ; 0.1125 |] ;

[| 0.3222169236216038 ; -0.1188883322987607e1 ; 0.1228145134023366e1 |] ;

[| -0.3501123898129943e-1 ; 0.3725420601086163 ; -0.2721053535582034 ; 0.1993037578575077e-1 |] ;

[| -0.5576547055042005 ; 0.1367307289645883e1 ; -0.1732236360460725e1 ; 0.4587772007467548 ; 0.9638065755722880 |] ;

[| 0.8654517193566155e-1 ; -0.8810082847945416e-1 ; 0.1981275547329404 ; 

-0.4645422679331083 ; 0.1615170091109488 ; 0.9064533606330119 |] ;

[| 0. ; 0. ; 0. ; 0.3624477248753816e1 ; -0.4617724189181256 ; -0.3198024628164272e1 ; 0.1035319798328740e1 |] |] ;;

let hem_5_3_b_fine = [| 0. ; 0. ; 0. ; 0.2467760667636791 ; 0.2106594087489728 ;

0.1769218149125021 ; 0.3064446444147922 ; 0.5919806516005373e-1 |] ;;

let hem_5_3_b_raw = [| 0. ; 0. ; 0. ; 0. ; 0. ; 0. ; 2.5 ; -1.5 |] ;;



let rk5_4_cash669_first_a = [| [| 0.25 |] ; [| 3. /. 32. ; 9. /. 32. |] ; [| 1932. /. 2197. ; -7200. /. 2197. ; 7296. /. 2197. |] ;

 [| 439. /. 216. ; -8. ; 3680. /. 513. ; -845. /. 4104. |] ; [| -8. /. 27. ; 2. ; -3544. /. 2565. ; 1859. /. 4104. ; -0.275 |] |] ;;

let rk5_4_cash669_first_b_fine = [| 16. /. 135. ; 0. ; 6656. /. 12825. ; 28561. /. 56430. ; -0.18 ; 2. /. 55. |] ;;

let rk5_4_cash669_first_b_halfdiff = [| 1. /. 360. ; 0. ; -128. /. 4275. ; -2197. /. 75240. ; 0.02 ; 0. |] ;;


(** *)


let rk5_4_cash669_first_b_raw = [| 0. ; 0. ; 1067091077380. /. 1829119027671. ; 3284168845918. /. 21339721989495. ;

 110317750789. /. 240996319200. -. 4448925830089. /. 12329617149531. ; 0.04 ; 0.2 ; 239992027043. /. 361494478800. ; 1273. /. 7800. |] ;;

rk5_4_cash669_first_b_raw.(0) <- 2. -. Matrix.vector_float_sum rk5_4_cash669_first_b_raw ;;




(** Ce qui suit pose prblème. What follows causes trouble. *)


let rk6_4_cash669_second_b_fine = [| 931. /. 6480. ; 0. ; 315392. /. 1500525. ; 371293. /. 615600. ; 0.02 ; 0.4 ; -4. /. 15. ; 85006. /. 115425. ; 239. /. 1560. |] ;;

let rk6_4_cash669_second_a = [| rk5_4_cash669_first_a.(0) ; rk5_4_cash669_first_a.(1) ; rk5_4_cash669_first_a.(2) ;

 rk5_4_cash669_first_a.(3) ; rk5_4_cash669_first_a.(4) ; Array.make 6 0. ;

 [| -119397029895. /. 151948225000. ; 78390. /. 29081. ; -51517464. /. 132821875. ; -3780749193. /. 1168832500. ; 79268193. /. 55925000. ; -11370591. /. 15379375. ; 5670. /. 2237. |] ;

 [| 23406188597. /. 8429231250. ; -62928. /. 13623. ; -31066887488. /. 5747203125. ; 164486461399. /. 8429231250. ;

 -70336084. /. 11203125. ; 185680664. /. 24646875. ; -3385330161. /. 243117160. ; 232648. /. 96795. |] |] ;;

let rk6_4_cash669_second_b_halfdiff = [| 0. ; 0. ; 0. ; 0.224620349650850 ; -0.038462277720213 ; 0.18 ; -7. /. 30. ; 0.036286203014893 ; -0.005 |] ;;


(** *)


let rk6_4_cash669_second_b_raw = rk5_4_cash669_first_b_raw ;;



let rk7_dormand_prince_a = [| [| 5.55555555555555555555555555556e-2 |] ;

 [| 2.08333333333333333333333333333e-2 ; 6.25e-2 |] ;

 [| 3.125e-2 ; 0.0 ; 9.375e-2 |] ;

 [| 3.125e-1 ; 0.0 ; -1.171875 ; 1.171875 |] ;

 [| 3.75e-2 ; 0.0 ; 0.0 ; 1.875e-1 ; 1.5e-1 |] ;

 [| 4.79101371111111111111111111111e-2 ; 0.0 ; 0.0 ; 1.12248712777777777777777777778e-1 ; -2.55056737777777777777777777778e-2 ;

 1.28468238888888888888888888889e-2 |] ;

 [| 1.6917989787292281181431107136e-2 ; 0.0 ; 0.0 ; 3.87848278486043169526545744159e-1 ;

 3.59773698515003278967008896348e-2 ; 1.96970214215666060156715256072e-1 ; -1.72713852340501838761392997002e-1 |] ;

 [| 6.90957533591923006485645489846e-2 ; 0.0 ; 0.0 ; -6.34247976728854151882807874972e-1 ; -1.61197575224604080366876923982e-1 ;

 1.38650309458825255419866950133e-1 ; 9.4092861403575626972423968413e-1 ; 2.11636326481943981855372117132e-1 |] ;

 [| 1.83556996839045385489806023537e-1 ; 0.0 ; 0.0 ; -2.46876808431559245274431575997 ; -2.91286887816300456388002572804e-1 ;

 -2.6473020233117375688439799466e-2 ; 2.84783876419280044916451825422 ; 2.81387331469849792539403641827e-1 ;

 1.23744899863314657627030212664e-1 |] ;

 [| -1.21542481739588805916051052503 ; 0.0 ; 0.0 ; 1.66726086659457724322804132886e1 ; 9.15741828416817960595718650451e-1 ;

 -6.05660580435747094755450554309 ; -1.60035735941561781118417064101e1 ; 1.4849303086297662557545391898e1 ;

 -1.33715757352898493182930413962e1 ; 5.13418264817963793317325361166 |] ;

 [| 2.58860916438264283815730932232e-1 ; 0.0 ; 0.0 ; -4.77448578548920511231011750971 ; -4.3509301377703250944070041181e-1 ;

 -3.04948333207224150956051286631 ; 5.57792003993609911742367663447 ; 6.15583158986104009733868912669 ;

 -5.06210458673693837007740643391 ; 2.19392617318067906127491429047 ; 1.34627998659334941535726237887e-1 |] ;

 [| 8.22427599626507477963168204773e-1 ; 0.0 ; 0.0 ; -1.16586732572776642839765530355e1 ; -7.57622116690936195881116154088e-1 ;

 7.13973588159581527978269282765e-1 ; 1.20757749868900567395661704486e1 ; -2.12765911392040265639082085897 ;

 1.99016620704895541832807169835 ; -2.34286471544040292660294691857e-1 ; 1.7589857770794226507310510589e-1 ; 0.0 |] |] ;;

let rk7_dormand_prince_b_raw = [| 4.17474911415302462220859284685e-2 ; 0.0 ; 0.0 ; 0.0 ; 0.0 ; -5.54523286112393089615218946547e-2

 ; 2.39312807201180097046747354249e-1 ; 7.0351066940344302305804641089e-1 ; -7.59759613814460929884487677085e-1 ;

 6.60563030922286341461378594838e-1 ; 1.58187482510123335529614838601e-1 ; -2.38109538752862804471863555306e-1 ; 2.5e-1 |] ;;

let rk7_dormand_prince_b_fine = [| 2.9553213676353496981964883112e-2 ; 0.0 ; 0.0 ; 0.0 ; 0.0 ; -8.28606276487797039766805612689e-1 ;

 3.11240900051118327929913751627e-1 ; 2.46734519059988698196468570407 ; -2.54694165184190873912738007542 ;

 1.44354858367677524030187495069 ; 7.94155958811272872713019541622e-2 ; 4.44444444444444444444444444445e-2 ; 0.0 |] ;;



let dormand_prince_8_5_3_a = [| [| 5.26001519587677318785587544488e-2 |] ; 

 [| 1.97250569845378994544595329183e-2 ; 5.91751709536136983633785987549e-2 |] ; 

 [| 2.95875854768068491816892993775e-2 ; 0. ; 8.87627564304205475450678981324e-2 |] ; 

 [| 2.41365134159266685502369798665e-1 ; 0. ; -8.84549479328286085344864962717e-1 ; 9.24834003261792003115737966543e-1 |] ; 

 [| 3.7037037037037037037037037037e-2 ; 0. ; 0. ; 1.70828608729473871279604482173e-1 ; 1.25467687566822425016691814123e-1 |] ; 

 [| 3.7109375e-2 ; 0. ; 0. ; 1.70252211019544039314978060272e-1 ; 6.02165389804559606850219397283e-2 ; -1.7578125e-2 |] ;

 [| 3.70920001185047927108779319836e-2 ; 0. ; 0. ; 1.70383925712239993810214054705e-1 ; 1.07262030446373284651809199168e-1 ; 

 -1.53194377486244017527936158236e-2 ; 8.27378916381402288758473766002e-3 |] ; 

 [| 6.24110958716075717114429577812e-1 ; 0. ; 0. ; -3.36089262944694129406857109825 ; -8.68219346841726006818189891453e-1 ; 

 2.75920996994467083049415600797e1 ; 2.01540675504778934086186788979e1 ; -4.34898841810699588477366255144e1 |] ; 

 [| 4.77662536438264365890433908527e-1 ; 0. ; 0. ; -2.48811461997166764192642586468 ;

 -5.90290826836842996371446475743e-1 ; 2.12300514481811942347288949897e1 ; 1.52792336328824235832596922938e1 ;

 -3.32882109689848629194453265587e1 ; -2.03312017085086261358222928593e-2 |] ;

 [| -9.3714243008598732571704021658e-1 ; 0. ; 0. ; 5.18637242884406370830023853209 ; 1.09143734899672957818500254654 ; 

 -8.14978701074692612513997267357 ; -1.85200656599969598641566180701e1 ; 2.27394870993505042818970056734e1 ; 

 2.49360555267965238987089396762 ; -3.0467644718982195003823669022 |] ; 

 [| 2.27331014751653820792359768449 ; 0. ; 0. ; -1.05344954667372501984066689879e1 ; -2.00087205822486249909675718444 ; 

 -1.79589318631187989172765950534e1 ; 2.79488845294199600508499808837e1 ; -2.85899827713502369474065508674 ; 

 -8.87285693353062954433549289258 ; 1.23605671757943030647266201528e1 ; 6.43392746015763530355970484046e-1 |] ;

 [| 0. ; 0. ; 0. ; 0. ; 0. ; 0. ; 0. ; 0. ; 0. ; 0. ; 0. ; 0. |] ;

 [| 5.61675022830479523392909219681e-2 ; 0. ; 0. ; 0. ; 0. ; 0. ; 2.53500210216624811088794765333e-1 ; 

 -2.46239037470802489917441475441e-1 ; -1.24191423263816360469010140626e-1 ; 1.5329179827876569731206322685e-1 ; 

 8.20105229563468988491666602057e-3 ; 7.56789766054569976138603589584e-3 ; -8.298e-3 |] ;

 [| 3.18346481635021405060768473261e-2 ; 0. ; 0. ; 0. ; 0. ; 2.83009096723667755288322961402e-2 ; 

 5.35419883074385676223797384372e-2 ; -5.49237485713909884646569340306e-2 ; 0. ; 0. ; -1.08347328697249322858509316994e-4 ;

 3.82571090835658412954920192323e-4 ; -3.40465008687404560802977114492e-4 ; 1.41312443674632500278074618366e-1 |] ; 

 [| -4.28896301583791923408573538692e-1 ; 0. ; 0. ; 0. ; 0. ; -4.69762141536116384314449447206 ; 

 7.68342119606259904184240953878 ; 4.06898981839711007970213554331 ; 3.56727187455281109270669543021e-1 ; 0. ; 0. ;

 0. ; -1.39902416515901462129418009734e-3 ; 2.9475147891527723389556272149 ; -9.15095847217987001081870187138 |] |] ;;

let dormand_prince_8_5_3_b_fine = [| 5.42937341165687622380535766363e-2 ; 0. ; 0. ; 0. ; 0. ; 4.45031289275240888144113950566 ; 

 1.89151789931450038304281599044 ; -5.8012039600105847814672114227 ; 3.1116436695781989440891606237e-1 ; 

 -1.52160949662516078556178806805e-1 ; 2.01365400804030348374776537501e-1 ; 4.47106157277725905176885569043e-2 ; 0. ; 0. ; 0. ; 0. |] ;;

let dormand_prince_8_5_3_b_err = [| 0.1312004499419488073250102996e-1 ; 0. ; 0. ; 0. ; 0. ; -0.1225156446376204440720569753e1 ; 

-0.4957589496572501915214079952 ; 0.1664377182454986536961530415e1 ; -0.3503288487499736816886487290 ; 

0.3341791187130174790297318841 ; 0.8192320648511571246570742613e-1 ; -0.2235530786388629525884427845e-1 ; 0. ; 0. ; 0. ; 0. |] ;;

let dormand_prince_8_5_3_b_raw = Matrix.vector_float_plus dormand_prince_8_5_3_b_err dormand_prince_8_5_3_b_fine ;;










(** 
§ 
 *)



(** 

Méthodes adaptatives quelconques


Unspecialized adaptative methods

*)



(** 
 
 *)











(** The following adaptative methods fit to any Runge-Kutta method, wether it is implicit or explicit.



Les méthodes adaptatives qui suivent sont adaptées à n'importe quelle méthode de Runge-Kutta, qu'elle soit implicite ou explicite. *)





(** 
 
 *)







(** 
float_end_ode_adapt methode tolerance function nsteps value beginning ending
 The methode must
give the final value of a solution.



La méthode methode doit donner la valeur finale d'une solution. *)


let rec float_end_ode_adapt = fun methode (tol:float) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and xx = ref beginning

 and y = ref y0

 and yy = ref y0

 and z = ref y0

 and zz = ref y0 in

  for i = 1 to nsteps do

   xx := !x +. step ;

   z := methode f 1 !yy !x !xx ;

   zz := methode f nsteps !yy !x !xx ;

   if abs_float ( !zz -. !z ) < tol *. abs_float !zz then yy := !zz

   else yy := float_end_ode_adapt methode tol f nsteps !yy !x !xx ;

   x := !xx ;

   y := !yy ;

  done ;

  !y ;;






(** 
vector_end_ode_adapt methode tolerance function nsteps value beginning ending
 The methode must
give the final value of a solution.



La méthode methode doit donner la valeur finale d'une solution. *)


let rec vector_end_ode_adapt = fun methode (tol:float) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and xx = ref beginning

 and y = ref ( Matrix.vector_float_copy y0 )

 and yy = ref ( Matrix.vector_float_copy y0 )

 and z = ref ( Matrix.vector_float_copy y0 )

 and zz = ref ( Matrix.vector_float_copy y0 ) in

  for i = 1 to nsteps do

   xx := !x +. step ;

   z := methode f 1 !yy !x !xx ;

   zz := methode f nsteps !yy !x !xx ;

   if ( Matrix.vector_float_norm_inf ( Matrix.vector_float_minus !zz !z ) ) < tol *. ( Matrix.vector_float_norm_inf !zz ) then yy := !zz

   else yy := vector_end_ode_adapt methode tol f nsteps !yy !x !xx ;

   x := !xx ;

   y := !yy ;

  done ;

  !y ;;






(** 
matrix_end_ode_adapt methode tolerance function nsteps value beginning ending
 The methode must
give the final value of a solution.



La méthode methode doit donner la valeur finale d'une solution. *)


let rec matrix_end_ode_adapt = fun methode (tol:float) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and x = ref beginning

 and xx = ref beginning

 and y = ref ( Matrix.matrix_float_copy y0 )

 and yy = ref ( Matrix.matrix_float_copy y0 )

 and z = ref ( Matrix.matrix_float_copy y0 )

 and zz = ref ( Matrix.matrix_float_copy y0 ) in

  for i = 1 to nsteps do

   xx := !x +. step ;

   z := methode f 1 !yy !x !xx ;

   zz := methode f nsteps !yy !x !xx ;

   if ( Matrix.matrix_float_norm_inf ( Matrix.matrix_float_minus !zz !z ) ) < tol *. ( Matrix.matrix_float_norm_inf !zz ) then yy := !zz

   else yy := matrix_end_ode_adapt methode tol f nsteps !yy !x !xx ;

   x := !xx ;

   y := !yy ;

  done ;

  !y ;;








(** 
float_end_ode_bounded maxstages methode tolerance function nsteps value beginning ending
 The methode must only give the final value
of the solution of the ordinary differential equation.



La méthode methode doit donner seulement la valeur finale de la solution de l'équation différentielle ordinaire. *)


let rec float_end_ode_bounded = fun (maxstages:int) methode (tol:float) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> methode f nsteps y0 beginning ending

 | _ -> 

  let step = ( ending -. beginning ) /. ( float nsteps )

  and y = ref y0

  and x = ref beginning

  and xx = ref beginning

  and yy = ref y0

  and z = ref y0

  and zz = ref y0 in

   for i = 1 to nsteps do

    xx := !x +. step ;

    z := methode f 1 !yy !x !xx ;

    zz := methode f nsteps !yy !x !xx ;

    if abs_float ( !zz -. !z ) < tol *. abs_float !zz then yy := !zz

    else yy := float_end_ode_bounded ( ( abs maxstages ) - 1 ) methode tol f nsteps !yy !x !xx ;

    x := !xx ;

    y := !yy ;

   done ;

   !y ;;






(** 
vector_end_ode_bounded maxstages methode tolerance function nsteps value beginning ending
 The methode must only give the final value
of the solution of the ordinary differential equation.



La méthode methode doit donner seulement la valeur finale de la solution de l'équation différentielle ordinaire. *)


let rec vector_end_ode_bounded = fun (maxstages:int) methode (tol:float) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> methode f nsteps y0 beginning ending

 | _ -> 

  let step = ( ending -. beginning ) /. ( float nsteps )

  and y = ref ( Matrix.vector_float_copy y0 )

  and x = ref beginning

  and xx = ref beginning

  and yy = ref ( Matrix.vector_float_copy y0 )

  and z = ref ( Matrix.vector_float_copy y0 )

  and zz = ref ( Matrix.vector_float_copy y0 ) in

   for i = 1 to nsteps do

    xx := !x +. step ;

    z := methode f 1 !yy !x !xx ;

    zz := methode f nsteps !yy !x !xx ;

    if ( Matrix.vector_float_norm_inf ( Matrix.vector_float_minus !zz !z ) ) < tol *. ( Matrix.vector_float_norm_inf !zz ) then yy := !zz

    else yy := vector_end_ode_bounded ( ( abs maxstages ) - 1 ) methode tol f nsteps !yy !x !xx ;

    x := !xx ;

    y := !yy ;

   done ;

   !y ;;






(** 
matrix_end_ode_bounded maxstages methode tolerance function nsteps value beginning ending
 The methode must only give the final value
of the solution of the ordinary differential equation.



La méthode methode doit donner seulement la valeur finale de la solution de l'équation différentielle ordinaire. *)


let rec matrix_end_ode_bounded = fun (maxstages:int) methode (tol:float) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> methode f nsteps y0 beginning ending

 | _ -> 

  let step = ( ending -. beginning ) /. ( float nsteps )

  and y = ref ( Matrix.matrix_float_copy y0 )

  and x = ref beginning

  and xx = ref beginning

  and yy = ref ( Matrix.matrix_float_copy y0 )

  and z = ref ( Matrix.matrix_float_copy y0 )

  and zz = ref ( Matrix.matrix_float_copy y0 ) in

   for i = 1 to nsteps do

    xx := !x +. step ;

    z := methode f 1 !yy !x !xx ;

    zz := methode f nsteps !yy !x !xx ;

    if ( Matrix.matrix_float_norm_inf ( Matrix.matrix_float_minus !zz !z ) ) < tol *. ( Matrix.matrix_float_norm_inf !zz ) then yy := !zz

    else yy := matrix_end_ode_bounded ( ( abs maxstages ) - 1 ) methode tol f nsteps !yy !x !xx ;

    x := !xx ;

    y := !yy ;

   done ;

   !y ;;








(** 
float_ode_adapt methode tolerance function nsteps value beginning ending
 *)


let rec float_ode_adapt = fun methode (tol:float) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and y = Array.make ( nsteps + 1 ) y0

 and x = ref beginning

 and xx = ref beginning

 and yy = ref y0

 and z = ref y0

 and zz = ref y0 in

  for i = 1 to nsteps do

   xx := !x +. step ;

   z := ( methode f 1 !yy !x !xx ).(1) ;

   zz := ( methode f nsteps !yy !x !xx ).(nsteps) ;

   if abs_float ( !zz -. !z ) < tol *. abs_float !zz then yy := !zz

   else yy := ( float_ode_adapt methode tol f nsteps !yy !x !xx ).(nsteps) ;

   x := !xx ;

   y.(i) <- !yy ;

  done ;

  y ;;






(** 
vector_ode_adapt methode tolerance function nsteps value beginning ending
 *)


let rec vector_ode_adapt = fun methode (tol:float) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and dim = Array.length y0

 and x = ref beginning

 and xx = ref beginning

 and yy = ref ( Matrix.vector_float_copy y0 )

 and z = ref ( Matrix.vector_float_copy y0 )

 and zz = ref ( Matrix.vector_float_copy y0 ) in

  let y = Array.make_matrix ( nsteps + 1 ) dim 0. in

   let row = y.(0) in

    for i = 0 to dim - 1 do

     row.(i) <- y0.(i) ;

    done ;

   for i = 1 to nsteps do

    xx := !x +. step ;

    z := ( methode f 1 !yy !x !xx ).(1) ;

    zz := ( methode f nsteps !yy !x !xx ).(nsteps) ;

    if ( Matrix.vector_float_norm_inf ( Matrix.vector_float_minus !zz !z ) ) < tol *. ( Matrix.vector_float_norm_inf !zz ) then yy := !zz

    else yy := ( vector_ode_adapt methode tol f nsteps !yy !x !xx ).(nsteps) ;

    x := !xx ;

    y.(i) <- !yy ;

   done ;

   y ;;






(** 
matrix_ode_adapt methode tolerance function nsteps value beginning ending
 *)


let rec matrix_ode_adapt = fun methode (tol:float) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 let step = ( ending -. beginning ) /. ( float nsteps )

 and dim_r = Array.length y0

 and dim_c = Array.length y0.(0)

 and x = ref beginning

 and xx = ref beginning

 and yy = ref ( Matrix.matrix_float_copy y0 )

 and z = ref ( Matrix.matrix_float_copy y0 )

 and zz = ref ( Matrix.matrix_float_copy y0 ) in

  let y = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( nsteps + 1 ) 0. ) in

   let row = y.(0) in

    for i = 0 to dim_r - 1 do

     row.(i) <- y0.(i) ;

    done ;

   for i = 1 to nsteps do

    xx := !x +. step ;

    z := ( methode f 1 !yy !x !xx ).(1) ;

    zz := ( methode f nsteps !yy !x !xx ).(nsteps) ;

    if ( Matrix.matrix_float_norm_inf ( Matrix.matrix_float_minus !zz !z ) ) < tol *. ( Matrix.matrix_float_norm_inf !zz ) then yy := !zz

    else yy := ( matrix_ode_adapt methode tol f nsteps !yy !x !xx ).(nsteps) ;

    x := !xx ;

    y.(i) <- !yy ;

   done ;

   y ;;








(** 
float_ode_bounded methode tolerance function nsteps value beginning ending
 *)


let rec float_ode_bounded = fun (maxstages:int) methode (tol:float) (f:float -> float -> float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> methode f nsteps y0 beginning ending

 | _ -> 

  let step = ( ending -. beginning ) /. ( float nsteps )

  and y = Array.make ( nsteps + 1 ) y0

  and x = ref beginning

  and xx = ref beginning

  and yy = ref y0

  and z = ref y0

  and zz = ref y0 in

   for i = 1 to nsteps do

    xx := !x +. step ;

    z := ( methode f 1 !yy !x !xx ).(1) ;

    zz := ( methode f nsteps !yy !x !xx ).(nsteps) ;

    if abs_float ( !zz -. !z ) < tol *. abs_float !zz then yy := !zz

    else yy := ( float_ode_bounded ( ( abs maxstages ) - 1 ) methode tol f nsteps !yy !x !xx ).(nsteps) ;

    x := !xx ;

    y.(i) <- !yy ;

   done ;

   y ;;






(** 
vector_ode_bounded methode tolerance function nsteps value beginning ending
 *)


let rec vector_ode_bounded = fun (maxstages:int) methode (tol:float) (f:float -> float array -> float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> methode f nsteps y0 beginning ending

 | _ -> 

  let step = ( ending -. beginning ) /. ( float nsteps )

  and dim = Array.length y0

  and x = ref beginning

  and xx = ref beginning

  and yy = ref ( Matrix.vector_float_copy y0 )

  and z = ref ( Matrix.vector_float_copy y0 )

  and zz = ref ( Matrix.vector_float_copy y0 ) in

   let y = Array.make_matrix ( nsteps + 1 ) dim 0. in

    let row = y.(0) in

     for i = 0 to dim - 1 do

      row.(i) <- y0.(i) ;

     done ;

   for i = 1 to nsteps do

    xx := !x +. step ;

    z := ( methode f 1 !yy !x !xx ).(1) ;

    zz := ( methode f nsteps !yy !x !xx ).(nsteps) ;

    if ( Matrix.vector_float_norm_inf ( Matrix.vector_float_minus !zz !z ) ) < tol *. ( Matrix.vector_float_norm_inf !zz ) then yy := !zz

    else yy := ( vector_ode_bounded ( ( abs maxstages ) - 1 ) methode tol f nsteps !yy !x !xx ).(nsteps) ;

    x := !xx ;

    y.(i) <- !yy ;

   done ;

   y ;;






(** 
matrix_ode_bounded methode tolerance function nsteps value beginning ending
 *)


let rec matrix_ode_bounded = fun (maxstages:int) methode (tol:float) (f:float -> float array array -> float array array) (nsteps:int) (y0:float array array) (beginning:float) (ending:float) ->

 match maxstages with 

 | 0 -> methode f nsteps y0 beginning ending

 | _ -> 

  let step = ( ending -. beginning ) /. ( float nsteps )

  and dim_r = Array.length y0

  and dim_c = Array.length y0.(0)

  and x = ref beginning

  and xx = ref beginning

  and yy = ref ( Matrix.matrix_float_copy y0 )

  and z = ref ( Matrix.matrix_float_copy y0 )

  and zz = ref ( Matrix.matrix_float_copy y0 ) in

   let y = Array.map ( Array.make_matrix dim_r dim_c ) ( Array.make ( nsteps + 1 ) 0. ) in

    let row = y.(0) in

     for i = 0 to dim_r - 1 do

      row.(i) <- y0.(i) ;

     done ;

   for i = 1 to nsteps do

    xx := !x +. step ;

    z := ( methode f 1 !yy !x !xx ).(1) ;

    zz := ( methode f nsteps !yy !x !xx ).(nsteps) ;

    if ( Matrix.matrix_float_norm_inf ( Matrix.matrix_float_minus !zz !z ) ) < tol *. ( Matrix.matrix_float_norm_inf !zz ) then yy := !zz

    else yy := ( matrix_ode_bounded ( ( abs maxstages ) - 1 ) methode tol f nsteps !yy !x !xx ).(nsteps) ;

    x := !xx ;

    y.(i) <- !yy ;

   done ;

   y ;;





let phem_5_6_a = [| [| 0. |] ; [| 3. /. 40. ; 9. /. 40. |] ;

[| 21. /. 256. ; 45. /. 256. ; 15. /. 128. |] ;

[| 19235. /. 98784. ; -225. /. 392. ; 6235. /. 6174. ; 2755. /. 32928. |] ;

[| -293. /. 1152. ; 85. /. 48. ; -2275. /. 1908. ; 35. /. 32. ; -2835. /. 6784. |] ;

( Array.sub dormand_prince_4_5_b_fine 0 6 ) ;

[| 10752038939. /. 66307507200. ; -19259. /. 50160. ; 19581770468. /. 24023520675. ;

 9941999. /. 650073600. ; 180060831. /. 4820710400. ; -11331659. /. 439538400. ; 1. /. 76. |] |] ;;

let phem_5_6_b_raw = dormand_prince_4_5_b_raw ;;

let phem_5_6_b_fine = [| 1812923. /. 20736000. ; 0. ; 45847. /. 100170. ; 56677. /. 414720. ;

-289161. /. 13568000. ; -67507. /. 4536000. ; -3971. /. 324000. |] ;;










(** 
§ 
 *)



(** 

Équations différentielles ordinaires implicites f(x,y,y') = 0.


Implicit ordinary differential equations f(x,y,y') = 0.

*)



(** 
 
 *)











(** The resolutions presented here work if it is possible to extract an implicit function in order to give y'.



Les présentes résolutions fonctionnent s'il est possible d'extraire une fonction implicite pour donner y'. *)





(** 
 
 *)







(** 
float_ode_implicit methode_ode methode_zero function guess nsteps value beginning ending
 The ordinary 
differential equations solving method methode_ode must apply to explicit equations y' = f(x,y) as in the following example.
The hint guess permits to proceed to an initial seek for y'(beginning).
Beware ! this method is polymorphic and gives at end either a vector or a real, mimicing the behaviour of methode_ode.




float_ode_adapt ( float_ode_runge_kutta_adapt cash_karp_a cash_karp_b_fine cash_karp_b_raw 1e-1 ) 1e-2




La méthode methode_ode de résolution d'équations différentielles ordinaires doit s'appliquer 
aux équations explicites y' = f(x,y) comme dans l'exemple ci-dessus. 
L'indice guess permet de faire une recherche initiale pour y'(beginning).
Attention ! cette méthode est polymorphe et donne à la fin soit un vecteur soit un réel
calquant le ccomportement de methode_ode. *)


 let float_ode_implicit = fun methode_ode methode_zero (f:float -> float -> float -> float) (guess:float) (nsteps:int) (y0:float) (beginning:float) (ending:float) ->

  let z0 = float_local_inverse methode_zero guess ( f beginning y0 ) 0. in

   let g = fun x y -> float_local_inverse methode_zero z0 ( function z -> f x y z ) 0. in

    methode_ode g nsteps y0 beginning ending ;;








(** 
vector_ode_implicit methode_ode methode_zero function guess nsteps value beginning ending
 The ordinary 
differential equations solving method methode_ode must apply to explicit equations y' = f(x,y) as in the following example.
The hint guess permits to proceed to an initial seek for y'(beginning).
Beware ! this method is polymorphic and gives at end either a vector or a real, mimicing the behaviour of methode_ode.




vector_ode_adapt ( vector_ode_runge_kutta_adapt cash_karp_a cash_karp_b_fine cash_karp_b_raw 1e-1 ) 1e-2




La méthode methode_ode de résolution d'équations différentielles ordinaires doit s'appliquer 
aux équations explicites y' = f(x,y) comme dans l'exemple ci-dessus. 
L'indice guess permet de faire une recherche initiale pour y'(beginning).
Attention ! cette méthode est polymorphe et donne à la fin soit un vecteur soit un réel
calquant le ccomportement de methode_ode. *)


 let vector_ode_implicit = fun methode_ode methode_zero (f:float -> float array -> float array -> float array) (guess:float array) (nsteps:int) (y0:float array) (beginning:float) (ending:float) ->

  let nullvector = ( Array.make ( Array.length y0 ) 0. ) in

   let z0 = vector_local_inverse methode_zero guess ( f beginning y0 ) nullvector in

    let g = fun x y -> vector_local_inverse methode_zero z0 ( function z -> f x y z ) nullvector in

     methode_ode g nsteps y0 beginning ending ;;










(** 
§ 
 *)



(** 

Distributions

*)



(** 
 
 *)











(** 
gen_dirac_mass
 *)


let gen_dirac_mass = fun a f -> f a ;;






(** 
float_dirac_mass function
 *)


let float_dirac_mass = function (f:float -> 'a) ->

 f 0. ;;




(** 
float_gen_dirac_mass position function
 *)


let float_gen_dirac_mass = fun (a:float) (f:float -> 'a) ->

 f a ;;






(** 
float_dirac_comb size function
 *)


let float_dirac_comb = fun (size:int) (f:float -> float) ->

 let accu = ref ( f 0. ) in

  for i = 1 to abs size do

   accu := !accu +. f ( float i ) +. f ( float ( - i ) ) ;

  done ;

  !accu ;;




(** 
float_vector_dirac_comb size function
 *)


let float_vector_dirac_comb = fun (size:int) (f:float -> float array) ->

 let accu = ref ( f 0. ) in

  for i = 1 to abs size do

   accu := Matrix.vector_float_plus !accu ( Matrix.vector_float_plus ( f ( float i ) ) ( f ( float ( - i ) ) ) ) ;

  done ;

  !accu ;;




(** 
float_matrix_dirac_comb size function
 *)


let float_matrix_dirac_comb = fun (size:int) (f:float -> float array array) ->

 let accu = ref ( f 0. ) in

  for i = 1 to abs size do

   accu := Matrix.matrix_float_plus !accu ( Matrix.matrix_float_plus ( f ( float i ) ) ( f ( float ( - i ) ) ) ) ;

  done ;

  !accu ;;






(** 
vector_dirac_mass dimension function
 *)


let vector_dirac_mass = fun n (f:float array -> 'a) ->

 f ( Array.make n 0. ) ;;




(** 
vector_gen_dirac_mass position function
 *)


let vector_gen_dirac_mass = fun (a:float array) (f:float array -> 'a) ->

 f a ;;




(** 
matrix_dirac_mass n_rows n_columns function
 *)


let matrix_dirac_mass = fun r c (f:float array array -> 'a) ->

 f ( Array.make_matrix r c 0. ) ;;




(** 
matrix_gen_dirac_mass position function
 *)


let matrix_gen_dirac_mass = fun (a:float array array) (f:float array array -> 'a) ->

 f a ;;






(** 
float_dirac_family_bell parameter real
 *)


let float_dirac_family_bell = fun (n:float) (x:float) ->

 inv_sqrt_doublepi *. ( gauss_bell ( x *. n ) ) *. n ;;




(** 
float_dirac_family_rectangle parameter real
 *)


let float_dirac_family_rectangle = fun (n:float) (x:float) ->

 if abs_float x <= 1. /. n then 0.5 *. n

 else 0. ;;




(** 
float_dirac_family_triangle parameter real
 *)


let float_dirac_family_triangle = fun (n:float) (x:float) ->

 let xx = abs_float x and nn = 1. /. n in

  if xx <= nn then n *. n *. ( nn -. xx )

  else 0. ;;






(** 
float_distrib_deriv
 *)


let float_distrib_deriv = fun methode distribution ->

 function (f:'a -> float) -> -. ( distribution ( methode f ) ) ;;




(** 
vector_distrib_deriv
 *)


let vector_distrib_deriv = fun methode distribution ->

 function (f:'a -> float array) -> Matrix.vector_float_opp ( distribution ( methode f ) ) ;;




(** 
matrix_distrib_deriv
 *)


let matrix_distrib_deriv = fun methode distribution ->

 function (f:'a -> float array array) -> Matrix.matrix_float_opp ( distribution ( methode f ) ) ;;






(** 
float_variable_translation value function real
 *)


let float_variable_translation = fun (a:float) (f:float -> 'a) (x:float) ->

 f ( x +. a ) ;;




(** 
vector_float_variable_translation value function real
 *)


let vector_float_variable_translation = fun (a:float array) (f:float array -> 'a) (x:float array) ->

 f ( Matrix.vector_float_plus x a ) ;;




(** 
matrix_float_variable_translation value function real
 *)


let matrix_float_variable_translation = fun (a:float array array) (f:float array array -> 'a) (x:float array array) ->

 f ( Matrix.matrix_float_plus x a ) ;;






(** 
float_distrib_transform
 *)


let float_distrib_transform = fun transform distribution ->

 ( function (f:'a -> 'b) -> ( distribution ( transform f ) ) ) ;;










(** 
§ 
 *)



(** 

Constructions supplémentaires


Further constructions

*)



(** 
 
 *)











(** 
normal_cumul_distribution real
 *)


let normal_cumul_distribution = function (x:float) ->

 ( sqrt inv_doublepi ) *. float_int_multi_adapt float_simple_step_gauss_kronrod 100 1e-3 gauss_bell (-38.7) x ;;




(** 
normal_cumul_distribution_complem real
 *)


let normal_cumul_distribution_complem = function (x:float) ->

 ( sqrt inv_doublepi ) *. float_int_multi_adapt float_simple_step_gauss_kronrod 100 1e-3 gauss_bell x 38.7 ;;




(** 
erf real
 *)


let erf = function (x:float) ->

 let f = function y -> gauss_bell ( y *. sqrt_of_2) in

 2. *. inv_sqrt_pi *. float_int_multi_adapt float_simple_step_gauss_kronrod 100 1e-3 f 0. x ;;




(** 
erf_complem real
 *)


let erf_complem = function (x:float) ->

 let f = function y -> gauss_bell ( y *. sqrt_of_2) in

 2. *. inv_sqrt_pi *. float_int_multi_adapt float_simple_step_gauss_kronrod 100 1e-3 f x 38.7 ;;






(** 
normal_quantile real
 This function must be equal to probit.



Cette fonction doit être égale à probit. *)


let normal_quantile = function (x:float) ->

 let g = function y -> x -. normal_cumul_distribution y in

  float_zero_general ( float_richardson_binary_deriv 2 1e-3 ) 2 5 g 0.5 ;;






(** 
probit real
 This function must be equal to normal_quantile.



Cette fonction doit être égale à normal_quantile. *)


let probit = function (x:float) ->

 let g = function y -> 2. *. x -. erf_complem ( y ) in

  (-. sqrt_of_2 ) *. ( float_zero_general ( float_richardson_binary_deriv 2 1e-3 ) 2 5 g 0.5 ) ;;






(** 
sin_int real
 *)


let sin_int = function (x:float) ->

 float_int_multi_adapt float_simple_step_gauss_kronrod 100 1e-3 sinc 0. x ;;




(** 
si real
 *)


let si = function (x:float) ->

 float_int_multi_adapt float_simple_step_gauss_kronrod 100 1e-3 sinc 1000. x ;;




(** 
shi real
 *)


let shi = function (x:float) ->

 let f = function y ->

  begin

   match y with

   | 0. -> 1.

   | _ -> ( sinh y ) /. y

  end in

   float_int_multi_adapt float_simple_step_gauss_kronrod 100 1e-3 f 0. x ;;






(** 
elliptic_integral_first_kind k x
 *)


let elliptic_integral_first_kind = fun (k:float) (x:float) ->

 let f = function y ->

  let z = k *. ( sin y ) in

   1. /. ( sqrt ( 1. -. z *. z ) ) in

    float_int_multi_adapt float_simple_step_gauss_kronrod 100 1e-3 f 0. x ;;




(** 
elliptic_integral_second_kind k x
 *)


let elliptic_integral_second_kind = fun (k:float) (x:float) ->

 let f = function y ->

  let z = k *. ( sin y ) in

   sqrt ( 1. -. z *. z ) in

    float_int_multi_adapt float_simple_step_gauss_kronrod 100 1e-3 f 0. x ;;




(** 
elliptic_integral_secondBis_kind k x
 *)


let elliptic_integral_secondBis_kind = fun (k:float) (x:float) ->

 let f = function y ->

  let w = sin y in

   let z = k *. w in

    ( w *. w )  /. ( sqrt ( 1. -. z *. z ) ) in

     float_int_multi_adapt float_simple_step_gauss_kronrod 100 1e-3 f 0. x ;;




(** 
elliptic_integral_third_kind k c x
 *)


let elliptic_integral_third_kind = fun (k:float) (c:float) (x:float) ->

 let f = function y ->

  let w = sin y in

   let z = k *. w in

    1. /. ( ( w -. c ) *. ( sqrt ( 1. -. z *. z ) ) ) in

     float_int_multi_adapt float_simple_step_gauss_kronrod 100 1e-3 f 0. x ;;






(** 
elliptic_integral methode coefficients_up coefficients_down root_coefficients x
 The integration method methode
must contain all the parameters.



La méthode d'intégration methode doit contenir tous les paramètres. *)


let elliptic_integral = fun methode (num:float array array) (denom:float array array) (c:float array) (a:float) (x:float) ->

 let f = function y ->

  let z = float_polynomial_1 c y in

   float_rational_2 num denom y z in

    methode f a x ;;








(** 
expm_ode methode nsteps matrix
 *)


let expm_ode = fun methode (nsteps:int) (m:float array array) ->

 let f = fun x y -> Matrix.matrix_float_prod m y in

  methode f nsteps ( Matrix.eye_float m ) 0. 1. ;;






(** 
expm_ode_bis methode nsteps matrix
 *)


let expm_ode_bis = fun methode (nsteps:int) (m:float array array) ->

 let f = fun x y -> Matrix.matrix_float_plus ( Matrix.matrix_float_prod m y ) ( Matrix.matrix_float_prod y m ) in

  methode f nsteps ( Matrix.eye_float m ) 0. 0.5 ;;






(** 
slow_tune_expm threshold matrix
 *)


let slow_tune_expm = fun (threshold:float) (m:float array array) ->

 let n = Array.length m

 and ww = ref m

 and mm = ref m

 and mmm = ref m

 and z = Matrix.float_trace m in

  let zz = z /. ( float n ) in

   if zz <> 0. then

    mm := Matrix.matrix_float_minus m ( Matrix.scal_float n n zz )

   else

    mm := m ;

   let zzz = Matrix.matrix_float_norm_inf !mm


(** The bias is tuned by experimenatl adjustment.



Le biais est ajusté empiriquement. *)


   and biais = Util.float_pos_part ( 6. -. ( floor ( log_bin ( float n ) ) ) ) in

    let iteration = Util.float_pos_part ( ( ceil ( log_bin zzz ) ) -. biais ) in

     if iteration >= 1. then

      mmm := Matrix.matrix_float_scal_mult ( 2. ** ( -. iteration ) ) !mm

     else

      mmm := !mm ;

     let methode = matrix_end_ode_runge_kutta_simple_adapt dormand_prince_8_5_3_a dormand_prince_8_5_3_b_fine dormand_prince_8_5_3_b_raw threshold in

      let w = expm_ode methode 15 !mmm in

       ww := w ;

       if iteration <> 0. then

        begin

         for i = 1 to int_of_float iteration do

          ww := Matrix.matrix_float_prod !ww !ww ;

         done ; 

         ww := Matrix.matrix_float_scal_mult ( exp zz ) !ww ;

        end ;

        !ww ;;






(** 
slow_tune_expm_bis threshold matrix
 *)


let slow_tune_expm_bis = fun (threshold:float) (m:float array array) ->

 let n = Array.length m

 and ww = ref m

 and mm = ref m

 and mmm = ref m

 and z = Matrix.float_trace m in

  let zz = z /. ( float n ) in

   if zz <> 0. then

    mm := Matrix.matrix_float_minus m ( Matrix.scal_float n n zz )

   else

    mm := m ;

   let zzz = Matrix.matrix_float_norm_inf !mm


(** The bias is tuned by experimenatl adjustment.



Le biais est ajusté empiriquement. *)


   and biais = Util.float_pos_part ( 6. -. ( floor ( log_bin ( float n ) ) ) ) in

    let iteration = Util.float_pos_part ( ( ceil ( log_bin zzz ) ) -. biais ) in

     if iteration >= 1. then

      mmm := Matrix.matrix_float_scal_mult ( 2. ** ( -. iteration ) ) !mm

     else

      mmm := !mm ;

     let methode = matrix_end_ode_runge_kutta_simple_adapt dormand_prince_8_5_3_a dormand_prince_8_5_3_b_fine dormand_prince_8_5_3_b_raw threshold in

      let w = expm_ode_bis methode 15 !mmm in

       ww := w ;

       if iteration <> 0. then

        begin

         for i = 1 to int_of_float iteration do

          ww := Matrix.matrix_float_prod !ww !ww ;

         done ; 

         ww := Matrix.matrix_float_scal_mult ( exp zz ) !ww ;

        end ;

        !ww ;;






(** 
tune_expm threshold matrix
 *)


let tune_expm = fun (threshold:float) (m:float array array) ->

 let n = Array.length m

 and ww = ref m

 and mm = ref m

 and mmm = ref m

 and z = Matrix.float_trace m in

  let zz = z /. ( float n ) in

   if zz <> 0. then

    mm := Matrix.matrix_float_minus m ( Matrix.scal_float n n zz )

   else

    mm := m ;

   let zzz = Matrix.matrix_float_norm_inf !mm


(** The bias is tuned by experimenatl adjustment.



Le biais est ajusté empiriquement. *)


   and biais = Util.float_pos_part ( 6. -. ( floor ( log_bin ( float n ) ) ) ) in

    let iteration = Util.float_pos_part ( ( ceil ( log_bin zzz ) ) -. biais ) in

     if iteration >= 1. then

      mmm := Matrix.matrix_float_scal_mult ( 2. ** ( -. iteration ) ) !mm

     else

      mmm := !mm ;

     let methode = matrix_end_ode_runge_kutta_simple_adapt rk7_dormand_prince_a rk7_dormand_prince_b_fine rk7_dormand_prince_b_raw threshold in

      let w = expm_ode methode 36 !mmm in

       ww := w ;

       if iteration <> 0. then

        begin

         for i = 1 to int_of_float iteration do

          ww := Matrix.matrix_float_prod !ww !ww ;

         done ; 

         ww := Matrix.matrix_float_scal_mult ( exp zz ) !ww ;

        end ;

        !ww ;;






(** 
tune_expm_bis threshold matrix
 *)


let tune_expm_bis = fun (threshold:float) (m:float array array) ->

 let n = Array.length m

 and ww = ref m

 and mm = ref m

 and mmm = ref m

 and z = Matrix.float_trace m in

  let zz = z /. ( float n ) in

   if zz <> 0. then

    mm := Matrix.matrix_float_minus m ( Matrix.scal_float n n zz )

   else

    mm := m ;

   let zzz = Matrix.matrix_float_norm_inf !mm


(** The bias is tuned by experimenatl adjustment.



Le biais est ajusté empiriquement. *)


   and biais = Util.float_pos_part ( 6. -. ( floor ( log_bin ( float n ) ) ) ) in

    let iteration = Util.float_pos_part ( ( ceil ( log_bin zzz ) ) -. biais ) in

     if iteration >= 1. then

      mmm := Matrix.matrix_float_scal_mult ( 2. ** ( -. iteration ) ) !mm

     else

      mmm := !mm ;

     let methode = matrix_end_ode_runge_kutta_simple_adapt rk7_dormand_prince_a rk7_dormand_prince_b_fine rk7_dormand_prince_b_raw threshold in

      let w = expm_ode_bis methode 36 !mmm in

       ww := w ;

       if iteration <> 0. then

        begin

         for i = 1 to int_of_float iteration do

          ww := Matrix.matrix_float_prod !ww !ww ;

         done ; 

         ww := Matrix.matrix_float_scal_mult ( exp zz ) !ww ;

        end ;

        !ww ;;






(** 
slow_direct_expm matrix
 *)


let slow_direct_expm = function (m:float array array) ->

 let n = Array.length m

 and ww = ref m

 and mm = ref m

 and mmm = ref m

 and z = Matrix.float_trace m in

  let zz = z /. ( float n )

  and nn = float n in

   if zz <> 0. then

    mm := Matrix.matrix_float_minus m ( Matrix.scal_float n n zz )

   else

    mm := m ;

   let zzz = Matrix.matrix_float_norm_inf !mm


(** The bias is tuned by experimenatl adjustment.



Le biais est ajusté empiriquement. *)


   and biais = Util.float_pos_part ( ceil ( 9.9 -. ( log_bin nn ) ) ) in

    let iteration = Util.float_pos_part ( ( ceil ( log_bin zzz ) ) -. biais ) in

     if iteration >= 1. then

      mmm := Matrix.matrix_float_scal_mult ( 2. ** ( -. iteration ) ) !mm

     else

      mmm := !mm ;


(** The threshold is tuned by experimenatl adjustment.



Le seuil est ajusté empiriquement. *)


     let threshold = min 9e-1 ( zzz *. epsilon_float *. 2. ** ( 1e1 *. nn ) ) in

      let methode = matrix_end_ode_runge_kutta_simple_adapt dormand_prince_8_5_3_a dormand_prince_8_5_3_b_fine dormand_prince_8_5_3_b_raw threshold in

       let w = [| expm_ode methode 14 !mmm ; expm_ode methode 20 !mmm ; expm_ode methode 28 !mmm |] in

        ww := Matrix.matrix_trans_float_approx w ;

        if iteration <> 0. then

         begin

          for i = 1 to int_of_float iteration do

           ww := Matrix.matrix_float_prod !ww !ww ;

          done ; 

          ww := Matrix.matrix_float_scal_mult ( exp zz ) !ww ;

         end ;

         !ww ;;






(** 
slow_direct_expm_bis matrix
 *)


let slow_direct_expm_bis = function (m:float array array) ->

 let n = Array.length m

 and ww = ref m

 and mm = ref m

 and mmm = ref m

 and z = Matrix.float_trace m in

  let zz = z /. ( float n )

  and nn = float n in

   if zz <> 0. then

    mm := Matrix.matrix_float_minus m ( Matrix.scal_float n n zz )

   else

    mm := m ;

   let zzz = Matrix.matrix_float_norm_inf !mm


(** The bias is tuned by experimenatl adjustment.



Le biais est ajusté empiriquement. *)


   and biais = Util.float_pos_part ( ceil ( 9.9 -. ( log_bin nn ) ) ) in

    let iteration = Util.float_pos_part ( ( ceil ( log_bin zzz ) ) -. biais ) in

     if iteration >= 1. then

      mmm := Matrix.matrix_float_scal_mult ( 2. ** ( -. iteration ) ) !mm

     else

      mmm := !mm ;


(** The threshold is tuned by experimenatl adjustment.



Le seuil est ajusté empiriquement. *)


     let threshold = min 9e-1 ( zzz *. epsilon_float *. 2. ** ( 1e1 *. nn ) ) in

      let methode = matrix_end_ode_runge_kutta_simple_adapt dormand_prince_8_5_3_a dormand_prince_8_5_3_b_fine dormand_prince_8_5_3_b_raw threshold in

       let w = [| expm_ode_bis methode 14 !mmm ; expm_ode_bis methode 20 !mmm ; expm_ode_bis methode 28 !mmm |] in

        ww := Matrix.matrix_trans_float_approx w ;

        if iteration <> 0. then

         begin

          for i = 1 to int_of_float iteration do

           ww := Matrix.matrix_float_prod !ww !ww ;

          done ; 

          ww := Matrix.matrix_float_scal_mult ( exp zz ) !ww ;

         end ;

         !ww ;;






(** 
direct_expm matrix
 *)


let direct_expm = function (m:float array array) ->

 let n = Array.length m

 and ww = ref m

 and mm = ref m

 and mmm = ref m

 and z = Matrix.float_trace m in

  let zz = z /. ( float n )

  and nn = float n in

   if zz <> 0. then

    mm := Matrix.matrix_float_minus m ( Matrix.scal_float n n zz )

   else

    mm := m ;

   let zzz = Matrix.matrix_float_norm_inf !mm


(** The bias is tuned by experimenatl adjustment.



Le biais est ajusté empiriquement. *)


   and biais = Util.float_pos_part ( 6. -. ( floor ( log_bin nn ) ) ) in

    let iteration = Util.float_pos_part ( ( ceil ( log_bin zzz ) ) -. biais ) in

     if iteration >= 1. then

      mmm := Matrix.matrix_float_scal_mult ( 2. ** ( -. iteration ) ) !mm

     else

      mmm := !mm ;


(** The threshold is tuned by experimenatl adjustment.



Le seuil est ajusté empiriquement. *)


     let threshold = min 9e-1 ( zzz *. epsilon_float *. 2. ** nn ) in

      let methode = matrix_end_ode_runge_kutta_simple_adapt rk7_dormand_prince_a rk7_dormand_prince_b_fine rk7_dormand_prince_b_raw threshold in

       let w = expm_ode methode 36 !mmm in

        ww := w ;

        if iteration <> 0. then

         begin

          for i = 1 to int_of_float iteration do

           ww := Matrix.matrix_float_prod !ww !ww ;

          done ; 

          ww := Matrix.matrix_float_scal_mult ( exp zz ) !ww ;

         end ;

         !ww ;;






(** 
direct_expm_bis matrix
 *)


let direct_expm_bis = function (m:float array array) ->

 let n = Array.length m

 and ww = ref m

 and mm = ref m

 and mmm = ref m

 and z = Matrix.float_trace m in

  let zz = z /. ( float n )

  and nn = float n in

   if zz <> 0. then

    mm := Matrix.matrix_float_minus m ( Matrix.scal_float n n zz )

   else

    mm := m ;

   let zzz = Matrix.matrix_float_norm_inf !mm


(** The bias is tuned by experimenatl adjustment.



Le biais est ajusté empiriquement. *)


   and biais = Util.float_pos_part ( 6. -. ( floor ( log_bin nn ) ) ) in

    let iteration = Util.float_pos_part ( ( ceil ( log_bin zzz ) ) -. biais ) in

     if iteration >= 1. then

      mmm := Matrix.matrix_float_scal_mult ( 2. ** ( -. iteration ) ) !mm

     else

      mmm := !mm ;


(** The threshold is tuned by experimenatl adjustment.



Le seuil est ajusté empiriquement. *)


     let threshold = min 9e-1 ( zzz *. epsilon_float *. 2. ** nn ) in

      let methode = matrix_end_ode_runge_kutta_simple_adapt rk7_dormand_prince_a rk7_dormand_prince_b_fine rk7_dormand_prince_b_raw threshold in

       let w = expm_ode_bis methode 36 !mmm in

        ww := w ;

        if iteration <> 0. then

         begin

          for i = 1 to int_of_float iteration do

           ww := Matrix.matrix_float_prod !ww !ww ;

          done ; 

          ww := Matrix.matrix_float_scal_mult ( exp zz ) !ww ;

         end ;

         !ww ;;






(** 
slow_expm matrix
 *)


let slow_expm = function (m:float array array) ->

 let mm = Matrix.matrix_float_scal_mult 0.5 m

 and mmm = Matrix.matrix_float_scal_mult (-0.5) m in

  let ww = slow_direct_expm mm

  and www = slow_direct_expm mmm in

   let inverse = Matrix.aggressive_inv www in

    Matrix.matrix_float_prod inverse ww ;;




(** 
slow_expm_bis matrix
 *)


let slow_expm_bis = function (m:float array array) ->

 let mm = Matrix.matrix_float_scal_mult 0.5 m

 and mmm = Matrix.matrix_float_scal_mult (-0.5) m in

  let ww = slow_direct_expm_bis mm

  and www = slow_direct_expm_bis mmm in

   let inverse = Matrix.aggressive_inv www in

    Matrix.matrix_float_prod inverse ww ;;






(** 
slow_expm_ter matrix
 *)


let slow_expm_ter = function (m:float array array) ->

 let mm = Matrix.matrix_float_scal_mult 0.25 m

 and mmm = Matrix.matrix_float_scal_mult (-0.5) m in

  let ww = slow_direct_expm mm

  and www = slow_direct_expm mmm in

   let inverse = Matrix.aggressive_inv www in

    Matrix.matrix_float_triple_prod ww inverse ww ;;




(** 
slow_expm_quater matrix
 *)


let slow_expm_quater = function (m:float array array) ->

 let mm = Matrix.matrix_float_scal_mult 0.25 m

 and mmm = Matrix.matrix_float_scal_mult (-0.5) m in

  let ww = slow_direct_expm_bis mm

  and www = slow_direct_expm_bis mmm in

   let inverse = Matrix.aggressive_inv www in

    Matrix.matrix_float_triple_prod ww inverse ww ;;












(** 
expm matrix
 *)


let expm = function (m:float array array) ->

 let mm = Matrix.matrix_float_scal_mult 0.5 m

 and mmm = Matrix.matrix_float_scal_mult (-0.5) m in

  let ww = direct_expm mm

  and www = direct_expm mmm in

   let inverse = Matrix.clean_inv www in

    Matrix.matrix_float_prod inverse ww ;;




(** 
expm_bis matrix
 *)


let expm_bis = function (m:float array array) ->

 let mm = Matrix.matrix_float_scal_mult 0.5 m

 and mmm = Matrix.matrix_float_scal_mult (-0.5) m in

  let ww = direct_expm_bis mm

  and www = direct_expm_bis mmm in

   let inverse = Matrix.clean_inv www in

    Matrix.matrix_float_prod inverse ww ;;






(** 
expm_ter matrix
 *)


let expm_ter = function (m:float array array) ->

 let mm = Matrix.matrix_float_scal_mult 0.25 m

 and mmm = Matrix.matrix_float_scal_mult (-0.5) m in

  let ww = direct_expm mm

  and www = direct_expm mmm in

   let inverse = Matrix.clean_inv www in

    Matrix.matrix_float_triple_prod ww inverse ww ;;




(** 
expm_quater matrix
 *)


let expm_quater = function (m:float array array) ->

 let mm = Matrix.matrix_float_scal_mult 0.25 m

 and mmm = Matrix.matrix_float_scal_mult (-0.5) m in

  let ww = direct_expm_bis mm

  and www = direct_expm_bis mmm in

   let inverse = Matrix.clean_inv www in

    Matrix.matrix_float_triple_prod ww inverse ww ;;








(** 
curv_absc methode_diff methode_int function x y
 The (unidimensional) derivating method methode_diff must contain the parameters, including the step.
The integrating method methode_int must contain all the needed parameters.



La méthode de dérivation (unidimensionnelle) methode_diff doit contenir les paramètres, y compris le pas.
La méthode d'intégration methode_int doit contenir tous les paramaètres nécessaires. *)


let curv_absc = fun methode_diff methode_int (f:float -> float array) (x:float) (y:float) ->

 let g = vector_speed methode_diff f in

  let h = function z -> Matrix.vector_float_norm_2 ( g z ) in

   methode_int h x y ;;






(** 
developpante methode_diff methode_int function parameter beginning real
 The (unidimensional) derivating method methode_diff must contain the parameters, including the step.
The integrating method methode_int must contain all the needed parameters.



La méthode de dérivation (unidimensionnelle) methode_diff doit contenir les paramètres, y compris le pas.
La méthode d'intégration methode_int doit contenir tous les paramaètres nécessaires. *)


let developpante = fun methode_diff methode_int (f:float -> float array) (parameter:float) (beginning:float) (x:float) ->

 let g = vector_speed methode_diff f in

  let h = function z -> Matrix.vector_float_norm_2 ( g z ) in

   let k = function z -> Matrix.vector_float_scal_left_div ( h z ) ( g z )

   and s = methode_int h beginning x in

    Matrix.vector_float_plus ( f x ) ( Matrix.vector_float_scal_mult ( parameter -. s ) ( k x ) ) ;;






(** 
prescribed_curvature_2 methode function nsteps beginning ending
 The vectorial ordinary differential equations solving method methode may either
give all the steps or only the final value.



La méthode de résolution d'équations différentielles ordinaires vectorielles methode peut soit donner tous les pas soit donner seulement la valeur finale. *)


let prescribed_curvature_2 = fun methode (kappa:float -> float) nsteps (beginning:float) (ending:float) ->

 let f = fun x v -> [| v.(2) ; v.(3) ; -. ( kappa x ) *. v.(3) ; ( kappa x ) *. v.(2) |] in

  methode f nsteps [| 0. ; 0. ; 1. ; 0. |] beginning ending ;;






(** 
prescribed_curvature_torsion_3 methode function nsteps beginning ending
 The vectorial ordinary differential equations solving method methode may either
give all the steps or only the final value.



La méthode de résolution d'équations différentielles ordinaires vectorielles methode peut soit donner tous les pas soit donner seulement la valeur finale. *)


let prescribed_curvature_torsion_3 = fun methode (kappa:float -> float) (tau:float -> float) nsteps (beginning:float) (ending:float) ->

 let f = fun x v -> [| v.(3) ; v.(4) ; v.(5) ; ( kappa x ) *. v.(4) ; -. ( kappa x ) *. v.(3) +. ( tau x ) *. v.(5) ; -. ( tau x ) *. v.(4) |] in

  methode f nsteps [| 0. ; 0. ; 0. ; 1. ; 0. ; 0. |] beginning ending ;;






(** 
prescribed_multicurvature methode function nsteps beginning ending
 The vectorial ordinary differential equations solving method methode may either
give all the steps or only the final value.



La méthode de résolution d'équations différentielles ordinaires vectorielles methode peut soit donner tous les pas soit donner seulement la valeur finale. *)


let prescribed_multicurvature = fun methode (kappa:float -> float array) nsteps (beginning:float) (ending:float) ->

 let l = Array.length ( kappa beginning ) in

  let ll = l + 1

  and lll = l - 1 in

   let r = 2 * ll in

    let f = fun x v ->

     begin

      let w = Array.make r 0. in

       for i = 0 to l do

        w.(i) <- v.( ll + i ) ;

       done ;

       w.(ll) <- ( kappa x ).(0) *. v.( ll + 1 ) ;

       w.( ll + l ) <- -. ( kappa x ).(lll) *. v.( l + l ) ;

       for i = 1 to lll do

        w.( ll + i ) <- -. ( kappa x ).( i - 1 ) *. v.( l + i ) +. ( kappa x ).(i) *. v.( ll + i + 1 ) ;

       done ;

      w

     end

    and init = Array.make r 0. in

     init.(ll) <- 1. ;

     methode f nsteps init beginning ending ;;






(** 
clothoid methode real
 The method methode is that of one-dimensional integration.



La méthode methode est celle d'intégration unidimensionnelle. *)


let clothoid = fun methode (x:float) ->

 let f = function s -> cos ( s *. s )

 and g = function s -> sin (s *. s ) in

  [| methode f 0. x ; methode g 0. x |] ;;










(** 
§ § § 
 *)










end ;;











module Sci = struct










(** 
§ 
 *)



(** 

Introduction

*)



(** 
 
 *)











(**
The mathematician will find in this module:



    

  • constructions in order to do the elementary operations with complex numbers in scientific notation whose mantissas are greater than fifty three bits,
    • 



    

  1. either with absolute precision, mantissas being big rational numbers, 
    2. 

  2. or with mantissas truncated at 1024 bits,
    3. 



    

  • common convergence acceleration methods,
    • 



    

  • functions on complex numbers in scientific notation whose mantissas are truncated at 1024 bits
(the last figures of the mantissa may be wrong):
    • 



    

  1. root functions,
    2. 

  2. solutions of polynomial equations of degree 2 or 3 or 4,
    3. 

  3. trigonometric functions.
    4. 




Conventions




A (complex) number in scientific notation is an array [| x ; y ; w |] of three numbers of type Num.num 
which represent z = ( x + i y ) * 2 ^ w. They satisfy x = y = w = 0 or 1 <= x ^ 2 + y ^ 2 < 4, and w is a big integer.



Some constants come from the module  Data.Classical.



This module is distributed under the same licence as Ocaml.




§ 




La mathématicienne ou le mathématicien trouvera dans ce module :



    

  • des constructions pour effectuer les opérations élémentaires avec des nombres complexes en notation scientifique dont la mantisse dépasse cinquante-trois bits :
    • 



    

  1. en précision absolue, les mantisses étant de grands nombres rationnels,
    2. 

  2. ou avec des mantisses tronquées à 1024 bits,
    3. 



    

  • des méthodes usuelles d'accélération de convergence,
    • 



    

  • des fonctions sur des nombres complexes en notation scientifique dont la mantisse est tronquée à 1024 bits
(les derniers chiffres de la mantisse peuvent être faux) : 
    • 



    

  1. fonctions racines,
    2. 

  2. solutions d'équations polynomiales de degré 2, 3 ou 4,
    3. 

  3. fonctions trigonométriques.
    4. 




Conventions




Un nombre (complexe) en notation scientifique est un tableau [| x ; y ; w |] de trois nombres de type Num.num 
qui représentent z = ( x + i y ) * 2 ^ w. Ils vérifient x = y = w = 0 ou bien 1 <= x ^ 2 + y ^ 2 < 4, et w est un grand entier.



Des constantes proviennent du module  Data.Classical.



Ce module est distribué selon la même licence qu'Ocaml.




Copyright Stéphane Grognet 


Laboratoire de mathématiques Jean Leray UMR 6629 CNRS 


Fédération de recherche mathématique des Pays de la Loire 


IREM des Pays de la Loire - Université de Nantes 


version 0.4

*)



(**
@version 0.4
*)



(**
@author Stéphane Grognet
*)



(**
@since 2011, 2012, 2013
*)










open Util ;;

open Data ;;

open Hash ;;

open Matrix ;;










(** 
§ 
 *)



(** 

Constantes diverses et mises en forme


Miscellaneous constants and formatting

*)



(** 
 
 *)











(** 
num_0
 *)


let num_0 = Num.num_of_int 0 ;;




(** 
num_1
 *)


let num_1 = Num.num_of_int 1 ;;




(** 
num_minus_1
 *)


let num_minus_1 = Num.minus_num num_1 ;;




(** 
num_2
 *)


let num_2 = Num.num_of_int 2 ;;




(** 
num_minus_2
 *)


let num_minus_2 = Num.num_of_int ( - 2 ) ;;




(** 
num_3
 *)


let num_3 = Num.num_of_int 3 ;;




(** 
num_minus_3
 *)


let num_minus_3 = Num.num_of_int ( - 3 ) ;;




(** 
num_3_over_2
 *)


let num_3_over_2 = Num.div_num num_3 num_2 ;;




(** 
num_minus_3_over_2
 *)


let num_minus_3_over_2 = Num.div_num num_minus_3 num_2 ;;




(** 
num_4
 *)


let num_4 = Num.num_of_int 4 ;;




(** 
num_minus_4
 *)


let num_minus_4 = Num.num_of_int ( - 4 )




(** 
num_5
 *)


let num_5 = Num.num_of_int 5




(** 
num_minus_5
 *)


let num_minus_5 = Num.num_of_int ( - 5 )




(** 
num_6
 *)


let num_6 = Num.num_of_int 6




(** 
num_minus_6
 *)


let num_minus_6 = Num.num_of_int ( - 6 )




(** 
num_7
 *)


let num_7 = Num.num_of_int 7




(** 
num_minus_7
 *)


let num_minus_7 = Num.num_of_int ( - 7 )




(** 
num_8
 *)


let num_8 = Num.num_of_int 8




(** 
num_minus_8
 *)


let num_minus_8 = Num.num_of_int ( - 8 )




(** 
num_9
 *)


let num_9 = Num.num_of_int 9




(** 
num_minus_9
 *)


let num_minus_9 = Num.num_of_int ( - 9 )




(** 
num_10
 *)


let num_10 = Num.num_of_int 10 ;;




(** 
num_minus_10
 *)


let num_minus_10 = Num.num_of_int ( - 10 )




(** 
num_12
 *)


let num_12 = Num.num_of_int 12 ;;




(** 
num_minus_12
 *)


let num_minus_12 = Num.num_of_int ( - 12 )




(** 
num_16
 *)


let num_16 = Num.num_of_int 16 ;;




(** 
num_minus_16
 *)


let num_minus_16 = Num.num_of_int ( - 16 )




(** 
num_27
 *)


let num_27 = Num.num_of_int 27 ;;




(** 
num_minus_27
 *)


let num_minus_27 = Num.num_of_int ( - 27 ) ;;




(** 
num_32
 *)


let num_32 = Num.num_of_int 32 ;;




(** 
num_minus_32
 *)


let num_minus_32 = Num.num_of_int ( - 32 )




(** 
num_64
 *)


let num_64 = Num.num_of_int 64 ;;




(** 
num_minus_64
 *)


let num_minus_64 = Num.num_of_int ( - 64 )




(** 
num_128
 *)


let num_128 = Num.num_of_int 128 ;;




(** 
num_minus_128
 *)


let num_minus_128 = Num.num_of_int ( - 128 )




(** 
num_256
 *)


let num_256 = Num.num_of_int 256 ;;




(** 
num_minus_256
 *)


let num_minus_256 = Num.num_of_int ( - 256 )




(** 
num_512
 *)


let num_512 = Num.num_of_int 512 ;;




(** 
num_minus_512
 *)


let num_minus_512 = Num.num_of_int ( - 512 )




(** 
num_1024
 *)


let num_1024 = Num.num_of_int 1024 ;;




(** 
num_minus_1024
 *)


let num_minus_1024 = Num.num_of_int ( - 1024 )




(** 
num_2048
 *)


let num_2048 = Num.num_of_int 2048 ;;




(** 
num_minus_2048
 *)


let num_minus_2048 = Num.num_of_int ( - 2048 )






(** 
num_2_pow_16
 *)


let num_2_pow_16 = Num.power_num num_2 num_16 ;;




(** 
num_2_pow_32
 *)


let num_2_pow_32 = Num.power_num num_2 num_32 ;;




(** 
num_2_pow_64
 *)


let num_2_pow_64 = Num.power_num num_2 num_64 ;;




(** 
num_2_pow_128
 *)


let num_2_pow_128 = Num.power_num num_2 num_128 ;;




(** 
num_2_pow_256
 *)


let num_2_pow_256 = Num.power_num num_2 num_256 ;;




(** 
num_2_pow_512
 *)


let num_2_pow_512 = Num.power_num num_2 num_512 ;;




(** 
num_2_pow_1024
 *)


let num_2_pow_1024 = Num.power_num num_2 num_1024 ;;




(** 
num_2_pow_2048
 *)


let num_2_pow_2048 = Num.power_num num_2 num_2048 ;;






(** 
num_05
 *)


let num_05 =  Num.div_num num_1 num_2 ;;




(** 
num_minus_05
 *)


let num_minus_05 =  Num.div_num num_minus_1 num_2 ;;






(** 
num_2_pow_minus_16
 *)


let num_2_pow_minus_16 = Num.power_num num_2 num_minus_16 ;;




(** 
num_2_pow_minus_32
 *)


let num_2_pow_minus_32 = Num.power_num num_2 num_minus_32 ;;




(** 
num_2_pow_minus_64
 *)


let num_2_pow_minus_64 = Num.power_num num_2 num_minus_64 ;;




(** 
num_2_pow_minus_128
 *)


let num_2_pow_minus_128 = Num.power_num num_2 num_minus_128 ;;




(** 
num_2_pow_minus_256
 *)


let num_2_pow_minus_256 = Num.power_num num_2 num_minus_256 ;;




(** 
num_2_pow_minus_512
 *)


let num_2_pow_minus_512 = Num.power_num num_2 num_minus_512 ;;




(** 
num_2_pow_minus_1024
 *)


let num_2_pow_minus_1024 = Num.power_num num_2 num_minus_1024 ;;






(** The num_of_float function is not provided by the Ocaml distribution.



La fonction num_of_float n'est pas fournie par la distribution Ocaml. *)





(** 
num_of_float real
 *)


let num_of_float = function (x:float) ->

 if abs_float x > max_float then failwith "Too big a float for Sci.num_of_float."

 else

  begin

   let s = ( string_of_float x ) ^ "e" in

    let i = String.index s 'e'

    and l = String.length s in

     let j = try String.index s '.' with Not_found -> i in

      let n = String.sub s 0 j

      and nn = if ( l <= 3 || i = j ) then "" else String.sub s ( j + 1 ) ( i - j - 1 )

      and e = if i = l - 1 then "0" else String.sub s ( i + 1 ) ( l - i - 2 )

      and d = String.make ( max 1 ( i - j ) ) '0' in

       String.set d 0 '1' ;

       let m = Num.num_of_string ( n ^ nn ^ "/" ^ d )

       and ee = Num.num_of_string e in

        let p = Num.power_num num_10 ee in

         Num.mult_num m p

  end ;;   






(** 
num_epsilon_float
 *)


let num_epsilon_float = num_of_float epsilon_float ;;




(** 
num_min_float
 *)


let num_min_float = num_of_float min_float ;;




(** 
num_max_float
 *)


let num_max_float = num_of_float max_float ;;




(** 
num_min_int
 *)


let num_min_int = Num.num_of_int min_int ;;




(** 
num_max_int
 *)


let num_max_int = Num.num_of_int max_int ;;






(** 
sci_0
 *)


let sci_0 = [| num_0 ; num_0 ; num_0 |] ;;




(** 
sci_1
 *)


let sci_1 = [| num_1 ; num_0 ; num_0 |] ;;




(** 
sci_minus_1
 *)


let sci_minus_1 = [| num_minus_1 ; num_0 ; num_0 |] ;;




(** 
sci_i
 *)


let sci_i = [| num_0 ; num_1 ; num_0 |] ;;




(** 
sci_minus_i
 *)


let sci_minus_i = [| num_0 ; num_minus_1 ; num_0 |] ;;






(** 
sci_2
 *)


let sci_2 = [| num_1 ; num_0 ; num_1 |] ;;




(** 
sci_minus_2
 *)


let sci_minus_2 = [| num_minus_1 ; num_0 ; num_1 |] ;;




(** 
sci_2i
 *)


let sci_2i = [| num_0 ; num_1 ; num_1 |] ;;




(** 
sci_minus_2i
 *)


let sci_minus_2i = [| num_0 ; num_minus_1 ; num_1 |] ;;




(** 
sci_4
 *)


let sci_4 = [| num_1 ; num_0 ; num_2 |] ;;




(** 
sci_minus_4
 *)


let sci_minus_4 = [| num_minus_1 ; num_0 ; num_2 |] ;;




(** 
sci_4i
 *)


let sci_4i = [| num_0 ; num_1 ; num_2 |] ;;




(** 
sci_minus_4i
 *)


let sci_minus_4i = [| num_0 ; num_minus_1 ; num_2 |] ;;




(** 
sci_8
 *)


let sci_8 = [| num_1 ; num_0 ; num_3 |] ;;




(** 
sci_minus_8
 *)


let sci_minus_8 = [| num_minus_1 ; num_0 ; num_3 |] ;;




(** 
sci_8i
 *)


let sci_8i = [| num_0 ; num_1 ; num_3 |] ;;




(** 
sci_minus_8i
 *)


let sci_minus_8i = [| num_0 ; num_minus_1 ; num_3 |] ;;




(** 
sci_16
 *)


let sci_16 = [| num_1 ; num_0 ; num_4 |] ;;




(** 
sci_minus_16
 *)


let sci_minus_16 = [| num_minus_1 ; num_0 ; num_4 |] ;;




(** 
sci_16i
 *)


let sci_16i = [| num_0 ; num_1 ; num_4 |] ;;




(** 
sci_minus_16i
 *)


let sci_minus_16i = [| num_0 ; num_minus_1 ; num_4 |] ;;




(** 
sci_32
 *)


let sci_32 = [| num_1 ; num_0 ; num_5 |] ;;




(** 
sci_minus_32
 *)


let sci_minus_32 = [| num_minus_1 ; num_0 ; num_5 |] ;;




(** 
sci_32i
 *)


let sci_32i = [| num_0 ; num_1 ; num_5 |] ;;




(** 
sci_minus_32i
 *)


let sci_minus_32i = [| num_0 ; num_minus_1 ; num_5 |] ;;




(** 
sci_64
 *)


let sci_64 = [| num_1 ; num_0 ; num_6 |] ;;




(** 
sci_minus_64
 *)


let sci_minus_64 = [| num_minus_1 ; num_0 ; num_6 |] ;;




(** 
sci_64i
 *)


let sci_64i = [| num_0 ; num_1 ; num_6 |] ;;




(** 
sci_minus_64i
 *)


let sci_minus_64i = [| num_0 ; num_minus_1 ; num_6 |] ;;




(** 
sci_128
 *)


let sci_128 = [| num_1 ; num_0 ; num_7 |] ;;




(** 
sci_minus_128
 *)


let sci_minus_128 = [| num_minus_1 ; num_0 ; num_7 |] ;;




(** 
sci_128i
 *)


let sci_128i = [| num_0 ; num_1 ; num_7 |] ;;




(** 
sci_minus_128i
 *)


let sci_minus_128i = [| num_0 ; num_minus_1 ; num_7 |] ;;




(** 
sci_256
 *)


let sci_256 = [| num_1 ; num_0 ; num_8 |] ;;




(** 
sci_minus_256
 *)


let sci_minus_256 = [| num_minus_1 ; num_0 ; num_8 |] ;;




(** 
sci_256i
 *)


let sci_256i = [| num_0 ; num_1 ; num_8 |] ;;




(** 
sci_minus_256i
 *)


let sci_minus_256i = [| num_0 ; num_minus_1 ; num_8 |] ;;




(** 
sci_512
 *)


let sci_512 = [| num_1 ; num_0 ; num_9 |] ;;




(** 
sci_minus_512
 *)


let sci_minus_512 = [| num_minus_1 ; num_0 ; num_9 |] ;;




(** 
sci_512i
 *)


let sci_512i = [| num_0 ; num_1 ; num_9 |] ;;




(** 
sci_minus_512i
 *)


let sci_minus_512i = [| num_0 ; num_minus_1 ; num_9 |] ;;




(** 
sci_1024
 *)


let sci_1024 = [| num_1 ; num_0 ; num_10 |] ;;




(** 
sci_minus_1024
 *)


let sci_minus_1024 = [| num_minus_1 ; num_0 ; num_10 |] ;;




(** 
sci_1024i
 *)


let sci_1024i = [| num_0 ; num_1 ; num_10 |] ;;




(** 
sci_minus_1024i
 *)


let sci_minus_1024i = [| num_0 ; num_minus_1 ; num_10 |] ;;






(** 
sci_05
 *)


let sci_05 = [| num_1 ; num_0 ; num_minus_1 |] ;;




(** 
sci_minus_05
 *)


let sci_minus_05 = [| num_minus_1 ; num_0 ; num_minus_1 |] ;;




(** 
sci_05i
 *)


let sci_05i = [| num_0 ; num_1 ; num_minus_1 |] ;;




(** 
sci_minus_05i
 *)


let sci_minus_05i = [| num_0 ; num_minus_1 ; num_minus_1 |] ;;




(** 
sci_025
 *)


let sci_025 = [| num_1 ; num_0 ; num_minus_2 |] ;;




(** 
sci_minus_025
 *)


let sci_minus_2 = [| num_minus_1 ; num_0 ; num_minus_2 |] ;;




(** 
sci_025i
 *)


let sci_025i = [| num_0 ; num_1 ; num_minus_2 |] ;;




(** 
sci_minus_025i
 *)


let sci_minus_025i = [| num_0 ; num_minus_1 ; num_minus_2 |] ;;




(** 
sci_0125
 *)


let sci_0125 = [| num_1 ; num_0 ; num_minus_3 |] ;;




(** 
sci_minus_0125
 *)


let sci_minus_2 = [| num_minus_1 ; num_0 ; num_minus_3 |] ;;




(** 
sci_0125i
 *)


let sci_025i = [| num_0 ; num_1 ; num_minus_3 |] ;;




(** 
sci_minus_0125i
 *)


let sci_minus_025i = [| num_0 ; num_minus_1 ; num_minus_3 |] ;;




(** 
sci_2_pow_minus_4
 *)


let sci_2_pow_minus_4 = [| num_1 ; num_0 ; num_minus_4 |] ;;




(** 
sci_minus_2_pow_minus_4
 *)


let sci_minus_2_pow_minus_4 = [| num_minus_1 ; num_0 ; num_minus_4 |] ;;




(** 
sci_i_2_pow_minus_4
 *)


let sci_i_2_pow_minus_4 = [| num_0 ; num_1 ; num_minus_4 |] ;;




(** 
sci_minus_i_2_pow_minus_4
 *)


let sci_minus_i_2_pow_minus_4 = [| num_0 ; num_minus_1 ; num_minus_4 |] ;;




(** 
sci_2_pow_minus_5
 *)


let sci_2_pow_minus_5 = [| num_1 ; num_0 ; num_minus_5 |] ;;




(** 
sci_minus_2_pow_minus_5
 *)


let sci_minus_2_pow_minus_5 = [| num_minus_1 ; num_0 ; num_minus_5 |] ;;




(** 
sci_i_2_pow_minus_5
 *)


let sci_i_2_pow_minus_5 = [| num_0 ; num_1 ; num_minus_5 |] ;;




(** 
sci_minus_i_2_pow_minus_5
 *)


let sci_minus_i_2_pow_minus_5 = [| num_0 ; num_minus_1 ; num_minus_5 |] ;;




(** 
sci_2_pow_minus_6
 *)


let sci_2_pow_minus_6 = [| num_1 ; num_0 ; num_minus_6 |] ;;




(** 
sci_minus_2_pow_minus_6
 *)


let sci_minus_2_pow_minus_6 = [| num_minus_1 ; num_0 ; num_minus_6 |] ;;




(** 
sci_i_2_pow_minus_6
 *)


let sci_i_2_pow_minus_6 = [| num_0 ; num_1 ; num_minus_6 |] ;;




(** 
sci_minus_i_2_pow_minus_6
 *)


let sci_minus_i_2_pow_minus_6 = [| num_0 ; num_minus_1 ; num_minus_6 |] ;;




(** 
sci_2_pow_minus_7
 *)


let sci_2_pow_minus_7 = [| num_1 ; num_0 ; num_minus_7 |] ;;




(** 
sci_minus_2_pow_minus_7
 *)


let sci_minus_2_pow_minus_7 = [| num_minus_1 ; num_0 ; num_minus_7 |] ;;




(** 
sci_i_2_pow_minus_7
 *)


let sci_i_2_pow_minus_7 = [| num_0 ; num_1 ; num_minus_7 |] ;;




(** 
sci_minus_i_2_pow_minus_7
 *)


let sci_minus_i_2_pow_minus_7 = [| num_0 ; num_minus_1 ; num_minus_7 |] ;;




(** 
sci_2_pow_minus_8
 *)


let sci_2_pow_minus_8 = [| num_1 ; num_0 ; num_minus_8 |] ;;




(** 
sci_minus_2_pow_minus_8
 *)


let sci_minus_2_pow_minus_8 = [| num_minus_1 ; num_0 ; num_minus_8 |] ;;




(** 
sci_i_2_pow_minus_8
 *)


let sci_i_2_pow_minus_8 = [| num_0 ; num_1 ; num_minus_8 |] ;;




(** 
sci_minus_i_2_pow_minus_8
 *)


let sci_minus_i_2_pow_minus_8 = [| num_0 ; num_minus_1 ; num_minus_8 |] ;;




(** 
sci_2_pow_minus_9
 *)


let sci_2_pow_minus_9 = [| num_1 ; num_0 ; num_minus_9 |] ;;




(** 
sci_minus_2_pow_minus_9
 *)


let sci_minus_2_pow_minus_9 = [| num_minus_1 ; num_0 ; num_minus_9 |] ;;




(** 
sci_i_2_pow_minus_9
 *)


let sci_i_2_pow_minus_9 = [| num_0 ; num_1 ; num_minus_9 |] ;;




(** 
sci_minus_i_2_pow_minus_9
 *)


let sci_minus_i_2_pow_minus_9 = [| num_0 ; num_minus_1 ; num_minus_9 |] ;;




(** 
sci_2_pow_minus_10
 *)


let sci_2_pow_minus_10 = [| num_1 ; num_0 ; num_minus_10 |] ;;




(** 
sci_minus_2_pow_minus_10
 *)


let sci_minus_2_pow_minus_10 = [| num_minus_1 ; num_0 ; num_minus_10 |] ;;




(** 
sci_i_2_pow_minus_10
 *)


let sci_i_2_pow_minus_10 = [| num_0 ; num_1 ; num_minus_10 |] ;;




(** 
sci_minus_i_2_pow_minus_10
 *)


let sci_minus_i_2_pow_minus_10 = [| num_0 ; num_minus_1 ; num_minus_10 |] ;;






(** The formatting function of numbers in scientific notation is delicate 
and is useful to the definitions of the elementary operations.



La fonction de mise en forme des nombres en notation scientifique est délicate 
et sert aux définitions des opérations élémentaires. *)





(** 
format number
 *)


let rec format = function (a:Num.num array) ->

 let x = ref a.(0)

 and y = ref a.(1)

 and w = ref a.(2) in

  let m = ref ( Num.add_num ( Num.square_num !x ) ( Num.square_num !y ) ) in

   if Num.eq_num !m num_0 then [| num_0 ; num_0 ; num_0 |]

   else

    begin

     while Num.ge_num !m num_2_pow_1024 do

      w := Num.add_num !w num_512 ;

      x := Num.mult_num !x num_2_pow_minus_512 ;

      y := Num.mult_num !y num_2_pow_minus_512 ;

      m := Num.mult_num !m num_2_pow_minus_1024 ;

     done ;

     if Num.ge_num !m num_2_pow_512 then

      begin

       w := Num.add_num !w num_256 ;

       x := Num.mult_num !x num_2_pow_minus_256 ;

       y := Num.mult_num !y num_2_pow_minus_256 ;

       m := Num.mult_num !m num_2_pow_minus_512 ;

      end ;

     if Num.ge_num !m num_2_pow_256 then

      begin

       w := Num.add_num !w num_128 ;

       x := Num.mult_num !x num_2_pow_minus_128 ;

       y := Num.mult_num !y num_2_pow_minus_128 ;

       m := Num.mult_num !m num_2_pow_minus_256 ;

      end ;

     if Num.ge_num !m num_2_pow_128 then

      begin

       w := Num.add_num !w num_64 ;

       x := Num.mult_num !x num_2_pow_minus_64 ;

       y := Num.mult_num !y num_2_pow_minus_64 ;

       m := Num.mult_num !m num_2_pow_minus_128 ;

     end ;

     if Num.ge_num !m num_2_pow_64 then

      begin

       w := Num.add_num !w num_32 ;

       x := Num.mult_num !x num_2_pow_minus_32 ;

       y := Num.mult_num !y num_2_pow_minus_32 ;

       m := Num.mult_num !m num_2_pow_minus_64 ;

     end ;

     if Num.ge_num !m num_2_pow_32 then

      begin

       w := Num.add_num !w num_16 ;

       x := Num.mult_num !x num_2_pow_minus_16 ;

       y := Num.mult_num !y num_2_pow_minus_16 ;

       m := Num.mult_num !m num_2_pow_minus_32 ;

     end ;

     while Num.le_num !m num_2_pow_minus_1024 do

      w := Num.sub_num !w num_512 ;

      x := Num.mult_num !x num_2_pow_512 ;

      y := Num.mult_num !y num_2_pow_512 ;

      m := Num.mult_num !m num_2_pow_1024 ;

     done ;

     if Num.le_num !m num_2_pow_minus_512 then

      begin

       w := Num.sub_num !w num_256 ;

       x := Num.mult_num !x num_2_pow_256 ;

       y := Num.mult_num !y num_2_pow_256 ;

       m := Num.mult_num !m num_2_pow_512 ;

      end ;

     if Num.le_num !m num_2_pow_minus_256 then

      begin

       w := Num.sub_num !w num_128 ;

       x := Num.mult_num !x num_2_pow_128 ;

       y := Num.mult_num !y num_2_pow_128 ;

       m := Num.mult_num !m num_2_pow_256 ;

      end ;

     if Num.le_num !m num_2_pow_minus_128 then

      begin

       w := Num.sub_num !w num_64 ;

       x := Num.mult_num !x num_2_pow_64 ;

       y := Num.mult_num !y num_2_pow_64 ;

       m := Num.mult_num !m num_2_pow_128 ;

      end ;

     if Num.le_num !m num_2_pow_minus_64 then

      begin

       w := Num.sub_num !w num_32 ;

       x := Num.mult_num !x num_2_pow_32 ;

       y := Num.mult_num !y num_2_pow_32 ;

       m := Num.mult_num !m num_2_pow_64 ;

      end ;

     if Num.le_num !m num_2_pow_minus_32 then

      begin

       w := Num.sub_num !w num_16 ;

       x := Num.mult_num !x num_2_pow_16 ;

       y := Num.mult_num !y num_2_pow_16 ;

       m := Num.mult_num !m num_2_pow_32 ;

      end ;

     let mm = Num.float_of_num !m in

      let mmm = Num.num_of_int ( ( int_of_float ( floor ( ( log mm ) /. log 4. ) ) ) ) in

       let coeff = Num.power_num num_05 mmm in

        x := Num.mult_num !x coeff ;

        y := Num.mult_num !y coeff ;

        w := Num.add_num !w mmm ;

        m := Num.add_num ( Num.square_num !x ) ( Num.square_num !y ) ;

        if Num.ge_num !m num_4 then

         begin

          x := Num.div_num !x num_2 ;

          y := Num.div_num !y num_2 ;

          w := Num.succ_num !w ;

         end ;

         [| !x ; !y ; !w |]

    end ;;






(** 
sci_3
 *)


let sci_3 = format [| num_3 ; num_0 ; num_0 |] ;;




(** 
sci_minus_3
 *)


let sci_minus_3 = format [| num_minus_3 ; num_0 ; num_0 |] ;;




(** 
sci_3i
 *)


let sci_3i = format [| num_0 ; num_3 ; num_0 |] ;;




(** 
sci_6
 *)


let sci_6 = format [| num_3 ; num_0 ; num_1 |] ;;




(** 
sci_minus_6
 *)


let sci_minus_6 = format [| num_minus_3 ; num_0 ; num_1 |] ;;




(** 
sci_27
 *)


let sci_27 = format [| num_27 ; num_0 ; num_0 |] ;;




(** 
sci_minus_27
 *)


let sci_minus_27 = format [| num_minus_27 ; num_0 ; num_0 |] ;;




(** 
sci_10
 *)


let sci_10 = format [| num_10 ; num_0 ; num_0 |] ;;




(** 
sci_10i
 *)


let sci_10i = format [| num_0 ; num_10 ; num_0 |] ;;


















(** 
§ 
 *)



(** 

Fonctions élémentaires pour Num.num


Elementary functions for Num.num

*)



(** 
 
 *)











(** 
num_sqrt integer
 *)


let num_sqrt = function (x:int) ->

 Num.num_of_big_int ( Big_int.sqrt_big_int ( Big_int.big_int_of_int x ) ) ;;




(** 
num_add_int integer
 *)


let num_add_int = fun (x:int) (y:int) ->

 Num.add_num ( Num.num_of_int x ) ( Num.num_of_int y ) ;;




(** 
num_sub_int integer
 *)


let num_sub_int = fun (x:int) (y:int) ->

 Num.sub_num ( Num.num_of_int x ) ( Num.num_of_int y ) ;;




(** 
num_mult_int integer
 *)


let num_mult_int = fun (x:int) (y:int) ->

 Num.mult_num ( Num.num_of_int x ) ( Num.num_of_int y ) ;;




(** 
num_div_int integer
 *)


let num_div_int = fun (x:int) (y:int) ->

 Num.div_num ( Num.num_of_int x ) ( Num.num_of_int y ) ;;




(** 
num_mod_int integer
 *)


let num_mod_int = fun (x:int) (y:int) ->

 Num.mod_num ( Num.num_of_int x ) ( Num.num_of_int y ) ;;






(** 
make_fraction num denom
 *)


let make_fraction = fun (numer:int) (denom:int) ->

 Num.num_of_ratio ( Ratio.create_ratio ( Big_int.big_int_of_int numer ) ( Big_int.big_int_of_int denom ) ) ;;




(** 
print_make_fraction num denom
 *)


let print_make_fraction = fun (num:int) (denom:int) ->

 print_string ( Num.string_of_num ( make_fraction num denom ) ) ;;














(** 
§ 
 *)



(** 

Fonctions élémentaires pour les nombres complexes en notation scientifique


Elementary functions for complex numbers in scientific notation

*)



(** 
 
 *)











(** 
sci_copy number
 *)
 

let sci_copy = function (a:Num.num array) ->

 let b = Array.make 3 num_0 in

  for i = 0 to 2 do

   b.(i) <- Num.add_num num_0 a.(i) ;

  done ;

  b ;;




(** 
float_of_sci number
 *)


let float_of_sci = function (a:Num.num array) ->

 Array.map Num.float_of_num a ;;






(** 
complex_of_sci number
 *)


let complex_of_sci = function (a:Num.num array) ->

 let x = Num.mult_num a.(0) ( Num.power_num num_2 a.(2) )

 and y = Num.mult_num a.(1) ( Num.power_num num_2 a.(2) ) in

  let xx = Num.float_of_num x

  and yy = Num.float_of_num y in

   [| [| xx ; -. yy |] ; [| yy ; xx |] |] ;;






(** 
sci_of_num number
 *)


let sci_of_num = function (x:Num.num) ->

 format [| x ; num_0 ; num_0 |] ;;




(** 
sci_to_string_array number_array
 *)


let sci_to_string_array = function (z:Num.num array) ->

 let s = Array.map Num.string_of_num z in

  [| s.(0) ; s.(1) ; s.(2) |] ;;




(** 
sci_to_string number_array
 *)


let sci_to_string = function (z:Num.num array) ->

 let s = Array.map Num.string_of_num z in

  s.(0) ^ " ; " ^ s.(1) ^ " ; " ^ s.(2) ;;






(** 
sci_of_string_array string_array
 *)


let sci_of_string_array = function (s:string array) ->

 let x = Array.map Num.num_of_string s in

  format [| x.(0) ; x.(1) ; x.(2) |] ;;




(** 
sci_of_string string
 *)


let sci_of_string = function (s:string) ->

 let listing = Str.split ( Str.regexp " ; " ) s in

  let x = Array.map Num.num_of_string ( Array.of_list listing ) in

   format [| x.(0) ; x.(1) ; x.(2) |] ;;






(** 
sci_of_float real
 *)


let sci_of_float = function (x:float) ->

 sci_of_num ( num_of_float x ) ;;




(** 
sci_of_int integer
 *)


let sci_of_int = function (x:int) ->

 sci_of_num ( Num.num_of_int x ) ;;




(** 
sci_of_complex real
 *)


let sci_of_complex = function (z:float array array) ->

 let x = z.(0).(0)

 and y = z.(1).(0)

 and yy = z.(0).(1)

 and xx = z.(1).(1) in

  let a = num_of_float x

  and b = num_of_float y

  and aa = num_of_float xx

  and bb = num_of_float yy in

   format [| Num.add_num a aa ; Num.sub_num b bb ; num_minus_1 |] ;;






(** 
square_module number
 *)


let square_module = function (a:Num.num array) ->

 let x = a.(0)

 and y = a.(1)

 and w = a.(2) in

  let m = Num.add_num ( Num.square_num x ) ( Num.square_num y ) in

   format [| m ; num_0 ; Num.mult_num num_2 w |] ;;




(** 
norm_inf number
 *)


let norm_inf = function (a:Num.num array) ->

 let x = a.(0)

 and y = a.(1)

 and w = a.(2) in

  let m = Num.max_num ( Num.abs_num x ) ( Num.abs_num y ) in

   format [| m ; num_0 ; w |] ;;




(** 
norm_1 number
 *)


let norm_1 = function (a:Num.num array) ->

 let x = a.(0)

 and y = a.(1)

 and w = a.(2) in

  let m = Num.add_num ( Num.abs_num x ) ( Num.abs_num y ) in

   format [| m ; num_0 ; w |] ;;






(** 
real_part number
 *)


let real_part = function (a:Num.num array) ->

 format [| a.(0) ; num_0 ; a.(2) |] ;;




(** 
imag_part number
 *)


let imag_part = function (a:Num.num array) ->

 format [| a.(1) ; num_0 ; a.(2) |] ;;




(** 
real_part_abs number
 *)


let real_part_abs = function (a:Num.num array) ->

 format [| Num.abs_num a.(0) ; num_0 ; a.(2) |] ;;




(** 
imag_part_abs number
 *)


let imag_part_abs = function (a:Num.num array) ->

 format [| num_0 ; Num.abs_num a.(1) ; a.(2) |] ;;






(** 
opp number
 *)


let opp = function (a:Num.num array) ->

[| Num.minus_num a.(0) ; Num.minus_num a.(1) ; a.(2) |] ;;






(** 
itimes number
 *)


let itimes = function (a:Num.num array) ->

[| Num.minus_num a.(1) ; a.(0) ; a.(2) |] ;;






(** 
plus number1 number2
 *)


let rec plus = fun (a:Num.num array) (b:Num.num array) ->

 let w = a.(2)

 and ww = b.(2) in

  if Num.ge_num ww w then

   begin

    let www = Num.sub_num w ww in

     let w_w = Num.power_num num_2 www in

      let x = Num.mult_num a.(0) w_w

      and y = Num.mult_num a.(1) w_w in

       let xx = Num.add_num x b.(0)

       and yy = Num.add_num y b.(1) in

        format [| xx ; yy ; ww |]

   end

  else plus b a ;;




(** 
minus number1 number2
 *)


let rec minus = fun (a:Num.num array) (b:Num.num array) ->

 plus a ( opp b ) ;;




(** 
mult number1 number2
 *)


let mult = fun (a:Num.num array) (b:Num.num array) ->

 let w = a.(2)

 and ww = b.(2) in

  let www = Num.add_num ww w in

   let x = Num.mult_num a.(0) b.(0)

   and xx = Num.mult_num a.(1) b.(1)

   and y = Num.mult_num a.(0) b.(1)

   and yy = Num.mult_num a.(1) b.(0) in

    format [| Num.sub_num x xx ; Num.add_num y yy ; www |] ;;






(** 
conj number
 *)


let conj = function (a:Num.num array) ->

 [| a.(0) ; Num.minus_num a.(1) ; a.(2) |] ;;






(** 
inv number
 *)


let inv = function (a:Num.num array) ->

 let x = a.(0)

 and y = a.(1)

 and w = a.(2) in

  let m = Num.add_num ( Num.square_num x ) ( Num.square_num y ) in

   format [| Num.div_num x m ; Num.div_num ( Num.minus_num y ) m ;  Num.minus_num w |] ;;






(** 
div number1 number2
 *)


let div = fun (a:Num.num array) (b:Num.num array) ->

 mult a ( inv b ) ;;






(** 
eq_0 number
 *)


let eq_0 = function (a:Num.num array) ->

 let b = norm_inf a in

  b.(0) = num_0 ;;






(** 
not_eq_0 number
 *)


let not_eq_0 = function (a:Num.num array) ->

 let b = norm_inf a in

  b.(0) <> num_0 ;;






(** 
eq number1 number2
 *)


let eq = fun (a:Num.num array) (b:Num.num array) ->

 eq_0 ( minus a b ) ;;






(** 
not_eq number1 number2
 *)


let not_eq = fun (a:Num.num array) (b:Num.num array) ->

 not_eq_0 ( minus a b ) ;;






(** 
int_pow exponent number
 *)


let rec int_pow = fun (n:int) (a:Num.num array) -> match n with

 | 0 -> sci_1

 | 1 -> a

 | -1 -> inv a

 | _ ->

  begin

   if n < 0 then int_pow ( abs n ) ( inv a )

   else

    begin

     let b = int_pow ( n / 2 ) a in

      if n mod 2 = 0 then mult b b

      else mult ( mult b b ) a

    end

  end ;;






(** 
sci_epsilon_float
 *)


let sci_epsilon_float = sci_of_float epsilon_float ;;




(** 
sci_min_float
 *)


let sci_min_float = sci_of_float min_float ;;




(** 
sci_max_float
 *)


let sci_max_float = sci_of_float max_float ;;




(** 
sci_min_int
 *)


let sci_min_int = sci_of_int min_int ;;




(** 
sci_max_int
 *)


let sci_max_int = sci_of_int max_int ;;










(** 
§ 
 *)



(** 

Utilisation de structures creuses en arithmétique


Use of sparse structures in arithmetic

*)



(** 
 
 *)















(** The module Z is used as an argument for the functor Hashtbl.Make.



Le module Z sert d'argument au foncteur Hashtbl.Make. *)




module Z = struct



type t = int ;;

let equal = ( = ) ;;

let hash = Hashtbl.hash ;;



end ;;






(** The module P is used to construct hash tables where to store the prime numbers.



Le module P sert à construire des tables de hachage où stocker les nombres premiers. *)




module P = ( Hashtbl.Make (Z)

: sig

  include module type of Hashtbl.Make (Z)

 end

  with type key = int ) ;;




(** 
left_dump table
 *)


let left_dump = fun (x:'a P.t) ->

 let accu = P.fold ( fun key coeff liste -> key :: liste ) x [] in

 Array.of_list ( List.fast_sort compare accu ) ;;




(** 
primes_init size
 *)


let primes_init = fun (n:int) ->

 P.create n ;;




(** 
first_compare x y
 *)


let first_compare = fun x y ->

 compare ( fst x ) ( fst y ) ;;






(** The module H is used to construct hash tables where to store the prime factors of the factorial with multiplicity.



Le module H sert à construire des tables de hachage où stocker les facteurs premiers de la factorielle avec multiplicité. *)




module H = ( Hash.Make (Data.Zindex) (Hash.Z) (Data.Zcoeff)

: sig

  include module type of Hash.Make (Data.Zindex) (Hash.Z) (Data.Zcoeff)

 end

  with type index := int with type weight := int ) ;;



let powers_init = fun (n:int) ->

 H.create n ;;



let flush = function (h:H.t) ->

 Array.of_list ( H.flush h ) ;;






(** 
contract list_of_power_pairs
 The list must be ordered according to the first factors.



La liste doit être ordonnée selon les premiers facteurs. *)


let contract = function z ->

 let rec contract_aux = fun accu z ->

  match z with

  | [] -> accu

  | head :: tail ->

   begin

    match tail with

    | [] -> head :: accu

    | x :: queue ->

     begin

      if fst head = fst x then

       contract_aux accu ( ( fst head , ( snd head ) + ( snd x ) ) :: queue )

      else

       contract_aux ( head :: accu ) tail

     end

   end in

   List.rev ( contract_aux [] z ) ;;




(** 
complete_sieve_aux number step factor powers source factors primes
 *)


let complete_sieve_aux = fun (n:int) (step:int) (factor:int) (powers:H.t) (source:int array) (factors:(int * int) list array) (primes:int P.t) ->

 let nn = n / step in

  if not ( P.mem primes factor ) then

   P.add primes factor 0 ;

  for i = 1 to nn do

   let index = step * i in

    begin

     try

      source.(index) <- source.(index) / factor

     with _ ->

      ()

    end ;

    factors.(index) <- contract ( List.merge first_compare [ ( factor , 1 ) ] factors.(index ) ) ;

  done ;

  H.add powers ( factor , nn ) ;;




(** 
complete_sieve table_size number
 *)


let complete_sieve = fun (p:int) (n:int) ->

 let sn = succ n

 and powers = powers_init p

 and primes = primes_init p  in

  let factors = Array.make sn []

  and source = Array.make sn 1 in

   for i = 2 to n do

    source.(i) <- i

   done ;

   for i = 2 to n do

    try

     begin

      let factor = source.(i) in

       if factor <> 1 then

        complete_sieve_aux n i factor powers source factors primes

     end

    with _ ->

     ()

   done ;

   ( left_dump primes , factors , flush powers ) ;;




(** 
primes_sieve_aux number step factor source primes
 *)


let primes_sieve_aux = fun (n:int) (step:int) (factor:int) (source:int array) (primes:int P.t) ->

 let nn = n / step in

  if not ( P.mem primes factor ) then

   P.add primes factor 0 ;

  for i = 1 to nn do

   let index = step * i in

    begin

     try

      source.(index) <- source.(index) / factor

     with _ ->

      ()

    end ;

  done ;;






(** 
primes_sieve table_size number
 This function is ten to one hundred times slower than the unix function primes on moderate numbers.



Cette fonction est dix à cent fois plus lente que la fonction unix primes sur des nombres modérés. *)


let primes_sieve = fun (p:int) (n:int) ->

 let sn = succ n

 and primes = primes_init p in

  let source = Array.make sn 1 in

   for i = 2 to n do

    source.(i) <- i

   done ;

   for i = 2 to n do

    try

     begin

      let factor = source.(i) in

      if factor <> 1 then

       begin

        primes_sieve_aux n i factor source primes ;

       end

     end

    with _ ->

     ()

   done ;

   left_dump primes ;;




(** 
sieve number
 *)


let sieve = function (n:int) ->

 primes_sieve ( n / 64 ) n ;;




(** 
factorial_sieve_aux number step factor powers source primes
 *)


let factorial_sieve_aux = fun (n:int) (step:int) (factor:int) (powers:H.t) (source:int array) (primes:int P.t) ->

 let nn = n / step in

  if not ( P.mem primes factor ) then

   P.add primes factor 0 ;

  for i = 1 to nn do

   let index = step * i in

    begin

     try

      source.(index) <- source.(index) / factor

     with _ ->

      ()

    end ;

  done ;

  H.add powers ( factor , nn ) ;;




(** 
factorial_sieve table_size number
 *)


let factorial_sieve = fun (p:int) (n:int) ->

 let sn = succ n

 and powers = powers_init p

 and primes = primes_init p in

  let source = Array.make sn 1 in

   for i = 2 to n do

    source.(i) <- i

   done ;

   for i = 2 to n do

    try

     begin

      let factor = source.(i) in

       if factor <> 1 then

        factorial_sieve_aux n i factor powers source primes ;

     end

    with _ ->

     ()

   done ;

   ( left_dump primes , flush powers ) ;;






(** 
naive_factors number
 This function is slower than the following one but reacts well with big prime factors. 
In case of a prime number, the resulting list contains a unique element.



Cette fonction est plus lente que la suivante mais réagit bien avec de grands facteurs premiers. 
Dans le cas d'un nombre premier, la liste résultat ne contient qu'un élément. *)


let naive_factors = function (n:int) ->

 let p = sieve n

 and power = ref 0

 and dividend = ref n

 and accu = ref [] in

  let i = ref ( pred ( Array.length p ) ) in

   while !i >= 0 do

    let factor = p.(!i) in

     while ( !dividend mod factor == 0 ) do

      dividend := !dividend / factor ;

      incr power ;

     done ;

     if !power > 0 then

      accu := ( factor , !power ) :: !accu ;

     if !dividend = 1 then

      i := -1

     else

      begin

       power := 0 ;

       decr i ;

      end ;

   done ;

   !accu ;;






(** 
factors number
 This function calls the former one when it has not been able to factorize the number with small prime numbers.



Cett fonction appelle la précédente quand elle n'a pas pu factoriser entièrement le nombre avec de petits premiers.*)


let factors = fun (n:int) ->

 let p = sieve ( Util.int_sqrt n )

 and listing = ref []

 and power = ref 0

 and dividend = ref n

 and accu = ref [] in

  for i = 0 to pred ( Array.length p ) do

   let factor = p.(i) in

    while ( !dividend mod factor == 0 ) do

     dividend := !dividend / factor ;

     incr power ;

    done ;

    if !power > 0 then

     accu := ( factor , !power ) :: !accu ;

    power := 0 ;

  done ;

  if !dividend > 1 then

   begin

    listing := naive_factors !dividend ;

   end ;

  List.rev_append !accu !listing ;;




(** 
is_prime number
 *)


let is_prime = function (n:int) ->

 Util.list_is_empty ( List.tl ( factors n ) ) ;;






(** 
fact table_size number
 This way of calculating the factorial is quicker than that of the following chapter (inside the toplevel).



Cette manière de calculer la factorielle est plus rapide que celle du chapitre suivant (dans le toplevel). *)


let fact = fun (size:int) (n:int) ->

 let s = factorial_sieve size n

 and f = function ( x , y ) -> Big_int.power_int_positive_int x y in

  Array.fold_left Big_int.mult_big_int ( Util.big 1 ) ( Array.map f ( snd s ) ) ;;




(** 
approx_decimal_fact table_size number
 *)


let approx_decimal_fact = fun (size:int) (n:int) ->

 let f = float_of_sci ( sci_of_num ( Num.num_of_big_int ( fact size n ) ) ) in

  let expo = f.(2) *. ( log 2. ) /. ( log 10. ) in

   let expo_dec = float ( int_of_float expo ) in

    let mantissa = f.(0) *. ( 10. ** ( expo -. expo_dec ) ) in

     if mantissa < 10. then

      [| mantissa ; expo_dec |]

     else

      [| mantissa /. 10. ; expo_dec +. 1. |] ;;




(** 
phi_euler number
 *)


let phi_euler = function (n:int) ->

 let liste = ref ( factors n )

 and accu = ref 1 in

  while Util.list_non_empty !liste do

   let ( p , a ) = List.hd !liste in

    accu := !accu * ( Util.int_power ( pred a ) p ) * ( pred p ) ;

    liste := List.tl !liste ;

  done ;

  !accu ;;










(** 
§ 
 *)



(** 

Autour de PI


Around PI

*)



(** 
 
 *)











(**
Source : 



The CAML Numbers Reference Manual by Valérie Ménissier-Morain, technical
report 141, INRIA, july 1992 (available electronically,
ftp://ftp.inria.fr/INRIA/publication/RT/RT-0141.ps.gz).
*)



(** 
§ 
 *)







(** 
num_fact_aux num_integer1 num_integer2
 *)


let rec num_fact_aux = fun (x:Num.num) (y:Num.num) -> match Num.int_of_num y with

 | 0 -> x

 | 1 -> x

 | _ -> num_fact_aux ( Num.mult_num x y ) ( Num.pred_num y ) ;;




(** 
num_fact num_integer
 *)


let num_fact = function (x:Num.num) -> num_fact_aux num_1 ( Num.abs_num x ) ;;




(** 
print_num_fact num_integer
 *)


let print_num_fact = function (x:Num.num) -> print_string ( Num.string_of_num ( num_fact x ) ) ;;




(** 
sci_fact num_integer
 *)


let sci_fact = function (x:Num.num) -> format [| num_fact x ; num_0 ; num_0 |] ;;






(** 
num_sqrt640320 digits
 *)


let num_sqrt640320 = function (digits:int) ->

 let pow = Num.power_num ( Num.num_of_int 10 ) ( Num.num_of_int digits ) in

  ( Num.num_of_big_int ( Big_int.sqrt_big_int ( Num.big_int_of_num ( Num.mult_num ( Num.mult_num ( Num.num_of_int 640320 ) pow ) pow ) ) ) , pow ) ;;






(** 
num_approx_pi digits
 *)


let num_approx_pi = function (digits:int) ->

 let prod = ref num_12

 and sum = ref ( Num.num_of_int 13591409 )

 and d = ref ( Num.num_of_int 640320 )

 and n = ref ( Num.num_of_int ( 12 * 13591409 ) )

 and sixn = ref num_0

 and binom = ref num_1 
      (** 3n^2+3n+1 *)


 and pown3 = ref num_0 
      (** n^3 *)


 and ( sqrt , pow ) = num_sqrt640320 ( digits - 2 )

 and pow3 = Num.power_num ( Num.num_of_int 640320 ) num_3 in

  let pow_test = Num.mult_num pow num_10 in

   while Num.gt_num ( Num.abs_num ( Num.mult_num ( Num.mult_num !prod !sum ) pow_test ) ) !d do

    prod := Num.mult_num ( Num.mult_num ( Num.mult_num ( Num.num_of_int ( - 8 ) ) ( Num.succ_num !sixn ) ) ( Num.mult_num ( Num.add_num !sixn num_3 ) ( Num.add_num !sixn num_5 ) ) ) !prod ;

    sum := Num.add_num ( Num.num_of_int 545140134 ) !sum ;

    pown3 := Num.add_num !binom !pown3 ;

    d := Num.mult_num ( Num.mult_num !pown3 pow3 ) !d ;

    n := Num.add_num ( Num.mult_num ( Num.mult_num !pown3  pow3 ) !n ) ( Num.mult_num !prod !sum ) ;

    sixn := Num.add_num !sixn num_6 ;

    binom := Num.add_num !sixn !binom

   done ;

   Num.div_num ( Num.mult_num sqrt !d ) ( Num.mult_num !n pow ) ;;






(** 
num_show_pi digits
 *)


let num_show_pi = function (digits:int) ->

 Num.approx_num_fix digits ( num_approx_pi digits ) ;;






(** 
sci_approx_pi digits
 *)


let sci_approx_pi = function (digits:int) ->

 format [| num_approx_pi digits ; num_0 ; num_0 |] ;;






(** 
pi_1000_10
 *)


let pi_1000_10 = sci_approx_pi 1000 ;;




(** 
half_pi_1000_10
 *)


let half_pi_1000_10 = mult sci_05 pi_1000_10 ;;




(** 
sci_approx_ipi digits
 *)


let sci_approx_ipi = function (digits:int) ->

 format [| num_0 ; num_approx_pi digits ; num_0 |] ;;










(** 
§ 
 *)



(** 

Fonctions de base en précision fixe


Fixed precision basic functions

*)



(** 
 
 *)











(** The mantissa is truncated at 1024 bits.



La mantisse est tronquée à 1024 bits. *)







(** 
format_1024 number
 *)


let format_1024 = function (a:Num.num array ) ->

 let aa = format a in

  let x = Num.mult_num aa.(0) num_2_pow_1024

  and y = Num.mult_num aa.(1) num_2_pow_1024 in

   let xx = Util.round_num x

   and yy = Util.round_num y in

    format [| xx ; yy ; Num.sub_num aa.(2) num_1024 |] ;;




(** 
mantissa_threshold
 *)


let mantissa_threshold = [| num_1 ; num_0 ; num_minus_1024 |] ;;




(** 
print_sci_1024_2 number
 *)


let print_sci_1024_2 = function (a:Num.num array) ->

 print_string ( "real mantissa : " ^ ( Num.approx_num_exp 310 a.(0) ) ) ;

 print_newline () ;

 print_string ( "imaginary mantissa : " ^ ( Num.approx_num_exp 310 a.(1) ) ) ;

 print_newline () ;

 print_string ( "binary exponent : " ^ ( Num.string_of_num a.(2) ) ) ;

 print_newline () ;;






(** 
print_sci_1024_10 number
 *)


let print_sci_1024_10 = function (a:Num.num array) ->

 let b = Num.power_num num_2 a.(2) in

  print_string ( "real part : " ^ ( Num.approx_num_exp 310 ( Num.mult_num a.(0) b ) ) ) ;

  print_newline () ;

  print_string ( "imaginary part : " ^ ( Num.approx_num_exp 310 ( Num.mult_num a.(1) b ) ) ) ;

  print_newline () ;;




(** 
plus_1024 number1 number2
 *)


let plus_1024 = fun (a:Num.num array) (b:Num.num array) ->

 let p = plus ( format_1024 a ) ( format_1024 b ) in

  let x = Num.mult_num p.(0) num_2_pow_1024

  and y = Num.mult_num p.(1) num_2_pow_1024 in

   let xx = Util.round_num x

   and yy = Util.round_num y in

    format [| xx ; yy ; Num.sub_num p.(2) num_1024 |] ;;

     


(** 
minus_1024 number1 number2
 *)


let minus_1024 = fun (a:Num.num array) (b:Num.num array) ->

 let p = minus ( format_1024 a ) ( format_1024 b ) in

  let x = Num.mult_num p.(0) num_2_pow_1024

  and y = Num.mult_num p.(1) num_2_pow_1024 in

   let xx = Util.round_num x

   and yy = Util.round_num y in

    format [| xx ; yy ; Num.sub_num p.(2) num_1024 |] ;;




(** 
mult_1024 number1 number2
 *)


let mult_1024 = fun (a:Num.num array) (b:Num.num array) ->

 let aa = format a

 and bb = format b in

  let xa = Util.round_num ( Num.mult_num aa.(0) num_2_pow_1024 )

  and ya = Util.round_num ( Num.mult_num aa.(1) num_2_pow_1024 )

  and xb = Util.round_num ( Num.mult_num bb.(0) num_2_pow_1024 )

  and yb = Util.round_num ( Num.mult_num bb.(1) num_2_pow_1024 )

  and w = Num.add_num aa.(2) bb.(2) in

   let x = Num.mult_num xa xb

   and xx = Num.mult_num ya yb

   and y = Num.mult_num xa yb

   and yy = Num.mult_num ya xb in

    format_1024 [| Num.sub_num x xx ; Num.add_num y yy ; Num.sub_num w num_2048 |] ;;




(** 
square_module_1024 number
 *)


let square_module_1024 = function (a:Num.num array) ->

 let x = real_part a

 and y = imag_part a in

  plus_1024 ( mult_1024 x x ) ( mult_1024 y y ) ;;




(** 
norm_inf_1024 number
 *)


let norm_inf_1024 = function (a:Num.num array) ->

 let x = a.(0)

 and y = a.(1)

 and w = a.(2) in

  let m = Num.max_num ( Num.abs_num x ) ( Num.abs_num y ) in

   format_1024 [| m ; num_0 ; w |] ;;




(** 
norm_1_1024 number
 *)


let norm_1_1024 = function (a:Num.num array) ->

 let x = a.(0)

 and y = a.(1)

 and w = a.(2) in

  let m = Num.add_num ( Num.abs_num x ) ( Num.abs_num y ) in

   format_1024 [| m ; num_0 ; w |] ;;




(** 
div_1024 dividend divisor
 *)


let div_1024 = fun (a:Num.num array) (b:Num.num array) ->

 let aa = format_1024 a

 and bb = format_1024 b in

  format_1024 ( div aa bb ) ;;






(** 
real_sqrt_1024 number
 This function operates on the real part.



Cette fonction agit sur la partie réelle. *)


let real_sqrt_1024 = function (a:Num.num array) ->

 let aa = real_part a in

  let w = aa.(2) in

   let ww = Num.quo_num w num_2

   and www = Num.mod_num w num_2

   and x = ref ( Num.abs_num aa.(0) ) in

    if Num.sign_num www > 0 then x := Num.mult_num !x num_2 ;

    if Num.sign_num www < 0 then x := Num.mult_num !x num_05 ;

    let y = Num.mult_num !x num_2_pow_2048 in

     let z = Util.round_num y in

      let r = Num.num_of_big_int ( Big_int.sqrt_big_int ( Num.big_int_of_num z ) ) in

       let s = Num.mult_num r num_2_pow_minus_1024 in

        [| s ; num_0 ; ww |] ;;






(** 
module_1024 number
 *)


let module_1024 = function (a:Num.num array) ->

 real_sqrt_1024 ( square_module_1024 a ) ;;




(** 
real_part_compare_1024 number1 number2
 *)


let real_part_compare_1024 = fun (x:Num.num array) (y:Num.num array) ->

 let z = minus_1024 x y in

  Num.compare_num z.(0) num_0 ;;




(** 
imag_part_compare_1024 number1 number2
 *)


let imag_part_compare_1024 = fun (x:Num.num array) (y:Num.num array) ->

 let z = minus_1024 x y in

  Num.compare_num z.(1) num_0 ;;




(** 
eq_0_1024 number
 *)


let eq_0_1024 = function (z:Num.num array) ->

 ( ( Num.compare_num z.(0) num_0 ) = 0 ) && ( ( Num.compare_num z.(1) num_0 ) = 0 ) ;;




(** 
sqrt_1024 number
 *)


let sqrt_1024 = function (a:Num.num array) ->

 let m = square_module a

 and test = complex_of_sci [| a.(0) ; a.(1) ; num_0 |]

 and d = real_part a

 and dp = imag_part a

 and x = ref sci_0

 and y = ref sci_0 in

  if abs_float test.(0).(0) +. abs_float test.(0).(1) < epsilon_float then

   sci_0

  else

  let s = real_sqrt_1024 m in

   let pp = plus s d

   and mm = minus s d in

    let p_p = square_module pp

    and m_m = square_module mm in

     let c = Num.sign_num ( minus p_p m_m ).(0) in

      if c >= 0 then 

       begin

        x := real_sqrt_1024 ( mult sci_05 pp ) ;

        y := div dp ( mult sci_2 !x ) ;

       end

      else

       begin

        y := real_sqrt_1024 ( mult sci_05 mm ) ;

        x := div dp ( mult sci_2 !y ) ;

       end ;

      plus_1024 !x ( itimes !y ) ;;




(** 
inv_1024 number
 *)


let inv_1024 = function (a:Num.num array) ->

 let aa = format_1024 a in

  let x = aa.(0)

  and y = aa.(1)

  and w = aa.(2) in

   let m = Num.add_num ( Num.square_num x ) ( Num.square_num y ) in

    format_1024 [| Num.div_num x m ; Num.div_num ( Num.minus_num y ) m ;  Num.minus_num w |] ;;




(** 
int_pow_1024 exponent number
 *)


let rec int_pow_1024 = fun (n:int) (a:Num.num array) -> match n with

 | 0 -> sci_1

 | 1 -> a

 | -1 -> inv_1024 a

 | _ ->

  begin

   if n < 0 then int_pow_1024 ( abs n ) ( inv_1024 a )

   else

    begin

     let b = int_pow_1024 ( n / 2 ) a in

      if n mod 2 = 0 then mult_1024 b b

      else mult_1024 ( mult_1024 b b ) a

    end

  end ;;






(** 
solve_degree_2_1024 a b c
 Gives the two solutions of a x ^ 2 + b x + c = 0.



Donne les deux solutions x de a x ^ 2 + b x + c = 0. *)


let solve_degree_2_1024 = fun (a:Num.num array) (b:Num.num array) (c:Num.num array) ->

 let bb = mult_1024 b sci_minus_05 in

  let d = minus_1024 ( mult_1024 bb bb ) ( mult_1024 a c ) in

   if eq_0 d then

    begin

     let x = div_1024 bb a in

      [| x ; x |]

    end

   else

    begin

     let dd = sqrt_1024 d in

      let m = minus_1024 bb dd

      and p = plus_1024 bb dd in

       let mm = square_module_1024 m

       and pp = square_module_1024 p in

        let comp = Num.sign_num ( minus_1024 pp mm ).(0) in

         if comp >= 0 then 

          begin

           let x = div_1024 p a in

            [| x ; div_1024 c p |]

          end

         else

          begin

           let x = div_1024 m a in

            [| div_1024 c m ; x |]

          end

    end ;;






(** 
real_cubic_root_1024 threshold number
 This function operates on the real part.



Cette fonction agit sur la partie réelle. *)


let real_cubic_root_1024 = function (a:Num.num array) ->

 let aa = real_part a in

  let w = aa.(2)

  and x = ref ( Num.abs_num aa.(0) ) in

   let ww = Num.quo_num w num_3

   and www = Num.int_of_num ( Num.mod_num w num_3 ) in

    if www = 1 then x := Num.mult_num !x num_2 ;

    if www = 2 then x := Num.mult_num !x num_4 ;

    if www = -1 then x := Num.mult_num !x num_05 ;

    if www = -2 then x := Num.div_num !x num_4 ;

    let xx = Num.float_of_num !x in

     if abs_float xx <= min_float then sci_0

     else

      begin

       let yy = exp ( ( log xx ) /. 3. ) in

        let y = ref ( num_of_float yy )

        and i = ref 0

        and error = ref max_float in

         while !error > min_float do

          let z = !y in

           let zz = Num.div_num ( Num.add_num ( Num.mult_num num_2 z ) ( Num.div_num !x ( Num.square_num z ) ) ) num_3 in

            y := zz ;

            error := Num.float_of_num ( Num.abs_num ( Num.sub_num z zz ) ) ;

            i := succ !i

         done ;

         format_1024 [| Num.mult_num ( Num.num_of_int ( Num.sign_num aa.(0) ) ) !y ; num_0 ; ww |]

      end ;;






(** 
cubic_root_1024 number
 *)


let cubic_root_1024 = function (a:Num.num array) ->

 let w = a.(2)

 and z = ref [| a.(0) ; a.(1) ; num_0 |] in

  let ww = Num.quo_num w num_3

  and www = Num.int_of_num ( Num.mod_num w num_3 ) in

   if www = 1 then z := mult_1024 !z sci_2 ;

   if www = 2 then z := mult_1024 !z sci_4 ;

   if www = -1 then z := mult_1024 !z sci_05 ;

   if www = -2 then z := div_1024 !z sci_4 ;

   let zz = complex_of_sci !z in

    if ( abs_float zz.(0).(0) ) +. ( abs_float zz.(1).(0) ) <= epsilon_float then sci_0

    else

     begin

      let z_z = { Complex.re = zz.(0).(0) ; Complex.im = zz.(1).(0) } in

       let zzz = Complex.exp ( Complex.div ( Complex.log z_z ) { Complex.re = 3. ; Complex.im = 0. } ) in

        let xz = zzz.Complex.re

        and yz = zzz.Complex.im in

         let y = ref ( sci_of_complex [| [| xz ; -. yz |] ; [| yz ; xz |] |] )

         and i = ref 0

         and error = ref max_float in

          while !error > min_float do

           let x = !y in

            let xx = div_1024 ( plus_1024 ( mult_1024 sci_2 x ) ( div_1024 !z ( mult_1024 x x ) ) ) sci_3 in

             y := xx ;

             i := succ !i ;

             let e = complex_of_sci ( minus_1024 x xx ) in

              let ee = e.(0).(0)

              and eee = e.(1).(0) in

               error := sqrt ( ee *. ee +. eee *. eee ) ;

          done ;

          mult_1024 !y [| num_1 ; num_0 ; ww |]

     end ;;






(** 
nth_root_1024 order number
 *)


let nth_root_1024 = fun (n:int) (a:Num.num array) ->

 let w = a.(2)

 and nm1 = pred n

 and nn = Num.num_of_int n

 and n_n = sci_of_int n

 and z = ref [| a.(0) ; a.(1) ; num_0 |] in

  let ww = Num.quo_num w nn

  and n__n = sci_of_int nm1

  and www = Num.int_of_num ( Num.mod_num w nn ) in

   if www <> 0 then z := mult_1024 !z ( int_pow www sci_2 ) ;

   let zz = complex_of_sci !z in

    if ( abs_float zz.(0).(0) ) +. ( abs_float zz.(1).(0) ) <= epsilon_float then sci_0

    else

     begin

      let z_z = { Complex.re = zz.(0).(0) ; Complex.im = zz.(1).(0) } in

       let zzz = Complex.exp ( Complex.div ( Complex.log z_z ) { Complex.re = float n ; Complex.im = 0. } ) in

        let xz = zzz.Complex.re

        and yz = zzz.Complex.im in

         let y = ref ( sci_of_complex [| [| xz ; -. yz |] ; [| yz ; xz |] |] )

         and i = ref 0

         and error = ref max_float in

          while !error > min_float do

           let x = !y in

            let xx = div_1024 ( plus_1024 ( mult_1024 n__n x ) ( div_1024 !z ( int_pow_1024 nm1 x ) ) ) n_n in

             y := xx ;

             i := succ !i ;

             let e = complex_of_sci ( minus_1024 x xx ) in

              let ee = e.(0).(0)

              and eee = e.(1).(0) in

               error := sqrt ( ee *. ee +. eee *. eee ) ;

          done ;

          mult_1024 !y [| num_1 ; num_0 ; ww |]

     end ;;






(** 
sci_1024_jj
 Primitive sixth root of unity.



Racine sixième primitive de l'unité. *)


let sci_1024_jj = cubic_root_1024 sci_minus_1 ;;






(** 
sci_1024_j
 Primitive cubic root of unity.



Racine cubique primitive de l'unité. *)


let sci_1024_j = mult_1024 sci_1024_jj sci_1024_jj ;;






(** 
sci_1024_j2
 Second primitive cubic root of unity.



Deuxième racine cubique primitive de l'unité. *)


let sci_1024_j2 = conj sci_1024_j






(** 
sci_1024_primitive_root_of_unity integer
 Primitive nth root of unity.



Racine n-ème primitive de l'unité. *)


let sci_1024_primitive_root_of_unity = function (n:int) ->

 if n mod 2 = 0 then

  nth_root_1024 ( n / 2 ) sci_minus_1

 else

  let x = nth_root_1024 n sci_minus_1 in

   mult_1024 x x ;;






(** 
sqrt_1024_of_3
 *)


let sqrt_1024_of_3 = sqrt_1024 sci_3 ;;




(** 
sqrt_1024_of_27
 *)


let sqrt_1024_of_27 = sqrt_1024 sci_27 ;;






(** 
solve_degree_3_1024 a b c d
 Gives the three solutions of a x ^ 3 + b x ^ 2 + c x + d = 0.



Donne les trois solutions x de a x ^ 3 + b x ^ 2 + c x + d = 0. *)


let solve_degree_3_1024 = fun (a:Num.num array) (b:Num.num array) (c:Num.num array) (d:Num.num array) ->

 let b_a = div_1024 b a

 and c_a = div_1024 c a

 and d_a = div_1024 d a

 and f = fun x y -> Num.sign_num ( minus_1024 x.(0) y.(0) ).(0) in

  let p = minus_1024 c_a ( div_1024 ( mult_1024 b_a b_a ) sci_3 )

  and q = plus_1024 d_a ( minus_1024 ( div_1024 ( mult_1024 sci_2 ( int_pow_1024 3 b_a ) ) sci_27 ) ( div_1024 ( mult_1024 b_a c_a ) sci_3 ) ) in

   let pp = mult_1024 sci_minus_27 ( int_pow_1024 3 p )

   and qq = mult_1024 sci_27 q in

    let t = solve_degree_2_1024 sci_1 qq pp in

     let m1 = cubic_root_1024 t.(0)

     and m2 = cubic_root_1024 t.(1) in

      let mm1 = square_module_1024 m1

      and mm2 = square_module_1024 m2

      and a1 = ref m1

      and a2 = ref m2 in

       let diff = minus_1024 mm1 mm2

       and m3p = mult_1024 sci_minus_3 p in

        let s = Num.sign_num diff.(0) in

         if s >= 0 then a2 := div_1024 m3p m1

         else a1 := div_1024 m3p m2 ;

         let x1 = ref ( div_1024 ( plus_1024 !a1 !a2 ) sci_3 )

         and x2 = ref ( div_1024 ( plus_1024 ( mult_1024 sci_1024_j2 !a1 ) ( mult_1024 sci_1024_j !a2 ) ) sci_3 )

         and x3 = ref ( div_1024 ( plus_1024 ( mult_1024 sci_1024_j !a1 ) ( mult_1024 sci_1024_j2 !a2 ) ) sci_3 ) in

          let m = Array.map ( function x -> [| square_module_1024 x ; sci_copy x |] ) [| !x1 ; !x2 ; !x3 |] in

           Array.sort f m ;

           x2 := m.(1).(1) ;

           x3 := m.(2).(1) ;

           x1 := div_1024 ( opp q ) ( mult_1024 !x2 !x3 ) ;

           Array.map ( function x -> plus_1024 x ( div_1024 b_a sci_minus_3 ) ) [| !x1 ; !x2 ; !x3 |] ;;






(** 
solve_degree_4_1024 a b c d e
 Gives the four solutions of a x ^ 4 + b x ^ 3 + c x ^ 2 + d x + e = 0.



Donne les quatre solutions x de a x ^ 4 + b x ^ 3 + c x ^ 2 + d x + e = 0. *)


let solve_degree_4_1024 = fun (a:Num.num array) (b:Num.num array) (c:Num.num array) (d:Num.num array) (e:Num.num array) ->

 let b_a = div_1024 b a

 and c_a = div_1024 c a

 and d_a = div_1024 d a

 and e_a = div_1024 e a

 and f = fun x y -> Num.sign_num ( minus_1024 x.(0) y.(0) ).(0) in

  let b_4a = div b_a sci_4 in

   let sq_b_4a = mult_1024 b_4a b_4a in

   let p = minus_1024 c_a ( mult_1024 sq_b_4a sci_6 )

   and q = plus_1024 d_a ( minus_1024 ( int_pow_1024 3 ( mult sci_05 b_a ) ) ( mult sci_05 ( mult_1024 b_a c_a ) ) )

   and r = plus_1024 e_a ( minus_1024 ( mult_1024 c_a sq_b_4a ) ( plus_1024 ( mult_1024 sci_3 ( mult_1024 sq_b_4a sq_b_4a ) ) ( mult_1024 b_4a d_a ) ) )

   and g = function x -> minus_1024 ( mult sci_05 x ) b_4a in

    let pp = mult sci_2 p

    and qq = minus_1024 ( mult_1024 p p ) ( mult_1024 sci_4 r )

    and rr = opp ( mult_1024 q q ) in

     let t = solve_degree_3_1024 sci_1 pp qq rr in

      let m = Array.map ( function x -> [| square_module_1024 x ; sci_copy x |] ) t in

       Array.sort f m ;

       let m3 = sqrt_1024 m.(2).(1)

       and m2 = sqrt_1024 m.(1).(1) in

        let m1 = div_1024 ( opp q ) ( mult_1024 m2 m3 ) in

         let x1 = plus_1024 m1 ( plus_1024 m2 m3 )

         and x2 = minus_1024 m1 ( plus_1024 m2 m3 )

         and x3 = minus_1024 m2 ( plus_1024 m1 m3 )

         and x4 = minus_1024 m3 ( plus_1024 m1 m2 ) in

         Array.map g [| x1 ; x2 ; x3 ; x4 |] ;;






(** 
det_2_1024 sci_2x2_matrix
 *)


let det_2_1024 = fun (m:Num.num array array array) ->

 minus_1024 ( mult_1024 m.(0).(0) m.(1).(1) ) ( mult_1024 m.(0).(1) m.(1).(0) ) ;;




(** 
det_3_1024 sci_3x3_matrix
 *)


let det_3_1024 = fun (m:Num.num array array array) ->

 let a = mult_1024 m.(0).(0) ( det_2_1024 [| [| m.(1).(1) ; m.(1).(2) |] ; [| m.(2).(1) ; m.(2).(2) |] |] )

 and b = mult_1024 m.(0).(1) ( det_2_1024 [| [| m.(1).(2) ; m.(1).(0) |] ; [| m.(2).(2) ; m.(2).(0) |] |] )

 and c = mult_1024 m.(0).(2) ( det_2_1024 [| [| m.(1).(0) ; m.(1).(1) |] ; [| m.(2).(0) ; m.(2).(1) |] |] ) in

  plus_1024 ( plus_1024 a b ) c ;;










(** 
§ 
 *)



(** 

Accélérateurs de convergence en précision fixe


Fixed precision convergence accelerators

*)



(** 
 
 *)











(** 
aitken_seki_1024 u(n) u(n+1) u(n+2)
 *)


let aitken_seki_1024 = fun (a:Num.num array) (b:Num.num array) (c:Num.num array) ->


(** alternative definition
 let numer = det_2_1024 | [| a ; b |] ; [| b ; c |] |
 and denom = minus_1024 ( plus_1024 a c ) ( mult_1024 sci_2 b ) in
  div_1024 numer denom ;;
*)


 let d = minus_1024 b a

 and e = minus_1024 c b in

  let f = mult_1024 d e

  and g = minus_1024 d e in

   let h = div_1024 f g in

    plus_1024 b h ;;






(** 
aitken_seki_rec_1024 k n value_array
 *)


let rec aitken_seki_rec_1024 = fun (k:int) (n:int) (s:Num.num array array) ->

 if k < -1 then failwith "Needed k >= -1 in Sci.aitken_seki_rec_1024." ;

 if n < 0 then failwith "Negative index of sequence in Sci.aitken_seki_rec_1024." ;

 if Array.length s <= n + 2 * k then failwith "Too short sequence in Sci.aitken_seki_rec_1024." ;

 match k with

 | 0 -> s.(n)

 | 1 ->

  begin

   try

    aitken_seki_1024 s.(n) s.( n + 1 ) s.( n + 2 )

   with Failure unknown ->

    s.( n + 2 )

  end

 | _ ->

  let kk = pred k in

   let a = aitken_seki_rec_1024 kk n s

   and b = aitken_seki_rec_1024 kk ( n + 1 ) s

   and c = aitken_seki_rec_1024 kk ( n + 2 ) s in

    if eq_0 ( minus_1024 b a ) || eq_0 ( minus_1024 c b ) || eq_0 ( minus_1024 a c ) then c

    else

     begin

      try

       aitken_seki_1024 a b c

      with Failure unknown ->

       c

     end ;;






(** 
shanks2_1024 u(n) u(n+1) u(n+2) u(n+3) u(n+4)
 *)


let shanks2_1024 = fun (a:Num.num array) (b:Num.num array) (c:Num.num array) (d:Num.num array) (e:Num.num array) ->

 let delta0 = minus_1024 b a

 and delta1 = minus_1024 c b

 and delta2 = minus_1024 d c

 and delta3 = minus_1024 e d in

  let dd0 = minus_1024 delta1 delta0

  and dd1 = minus_1024 delta2 delta1

  and dd2 = minus_1024 delta3 delta2 in

   let denom = det_2_1024 [| [| dd0 ; dd1 |] ; [| dd1 ; dd2 |] |]

   and numer = det_3_1024 [| [| a ; b ; c |] ; [| b ; c ; d |] ; [| c ; d ; e |] |] in

    div_1024 numer denom ;;






(** 
wynn_1024 k n value_array
 *)


let rec wynn_1024 = fun (k:int) (n:int) (s:Num.num array array) ->

 if k < -1 then failwith "Needed k >= -1 in Sci.wynn_1024." ;

 let km1 = pred k

 and km2 = k - 2

 and np = succ n in

  match k with

  | -1 -> sci_0

  | 0 ->

   begin

    if n < 0 then failwith "Negative index of sequence in Sci.wynn_1024." ;

    if n > pred ( Array.length s ) then failwith "Too short sequence in Sci.wynn_1024." ;

    s.(n)

   end

  | _ -> 

   begin

    let a = wynn_1024 km2 np s

    and b = wynn_1024 km1 np s

    and c = wynn_1024 km1 n s in

     let d = minus_1024 b c in

      if eq_0 d then b

      else plus_1024 a ( div_1024 sci_1 d )

   end ;;






(** 
wynn_rho_1024 k n value_array
 *)


let rec wynn_rho_1024 = fun (k:int) (n:int) (s:Num.num array array) ->

 if k < -1 then failwith "Needed k >= -1 in Sci.wynn_rho_1024." ;

  let km1 = pred k

  and km2 = k - 2

  and np = succ n in

   match k with

   | -1 -> sci_0

   | 0 ->

    begin

     if n < 0 then failwith "Negative index of sequence in Sci.wynn_rho_1024." ;

     if n > pred ( Array.length s ) then failwith "Too short sequence in Sci.wynn_rho_1024." ;

     s.(n)

    end

   | _ -> 

    begin

     let a = wynn_rho_1024 km2 np s

     and b = wynn_rho_1024 km1 np s

     and c = wynn_rho_1024 km1 n s in

      let d = minus_1024 b c in

       if eq_0 d then b

       else plus_1024 a ( div_1024 ( sci_of_int k ) d )

    end ;;






(** 
brezinski_1024 k n value_array
 *)


let rec brezinski_1024 = fun (k:int) (n:int) (s:Num.num array array) ->

 if k < -1 then failwith "Needed k >= -1 in Sci.brezinski_1024." ;

 match k with

 | -1 -> sci_0

 | 0 ->

  begin

   if n < 0 then failwith "Negative index of sequence in Sci.brezinski_1024." ;

   if n > pred ( Array.length s ) then failwith "Too short sequence in Sci.brezinski_1024." ;

   s.(n)

  end

 | _ -> 

  begin

   let km1 = pred k

   and km2 = k - 2

   and np = succ n in

    match k mod 2 with

    | 1 ->

     begin

      let a = brezinski_1024 km2 np s

      and b = brezinski_1024 km1 np s

      and c = brezinski_1024 km1 n s in

       let d = minus_1024 b c in

        if eq_0 d then b

        else plus_1024 a ( div_1024 sci_1 d )

     end

    | _ ->

     begin

      let a = brezinski_1024 km2 np s

      and np2 = succ np in

       let b = brezinski_1024 km1 np2 s

       and bb = brezinski_1024 km1 np s

       and c = brezinski_1024 km2 np2 s

       and cc = brezinski_1024 km2 np s in

        let d = minus_1024 b bb

        and dd = minus_1024 c cc in

         let ee = mult_1024 d dd

         and eee = plus_1024 ( brezinski_1024 km1 n s ) ( brezinski_1024 km1 np2 s ) in

          let eeee = minus_1024 eee ( mult_1024 sci_2 ( brezinski_1024 km1 np s ) ) in

           if eq_0 eeee then b

           else plus_1024 a ( div_1024 ee eeee )

     end

  end ;;






(** 
approx_1024 value_array
 *)


let approx_1024 = function (s:Num.num array array) ->

 let rr = pred ( Array.length s ) in

  let kk = rr / 2

  and parity = rr mod 2 in

   if parity = 0 then ( aitken_seki_rec_1024 kk 0 s )

   else ( aitken_seki_rec_1024 kk 1 s ) ;;










(** 
§ 
 *)



(** 

Fonctions classiques en précision fixe


Fixed precision classical functions

*)



(** 
 
 *)











(** 
pi_1024
 *)


let pi_1024 = format_1024 ( sci_approx_pi 310 ) ;;




(** 
minus_pi_1024
 *)


let minus_pi_1024 = format_1024 ( opp ( sci_approx_pi 310 ) ) ;;




(** 
ipi_1024
 *)


let ipi_1024 = format_1024 ( sci_approx_ipi 310 ) ;;




(** 
minus_ipi_1024
 *)


let minus_ipi_1024 = format_1024 ( opp ( sci_approx_ipi 310 ) ) ;;




(** 
half_pi_1024
 *)


let half_pi_1024 = mult_1024 sci_05 pi_1024 ;;




(** 
minus_half_pi_1024
 *)


let minus_half_pi_1024 = mult_1024 sci_05 minus_pi_1024 ;;




(** 
half_ipi_1024
 *)


let half_ipi_1024 = mult_1024 sci_05 ipi_1024 ;;




(** 
minus_half_ipi_1024
 *)


let minus_half_ipi_1024 = mult_1024 sci_05 minus_ipi_1024 ;;




(** 
quarter_pi_1024
 *)


let quarter_pi_1024 = mult_1024 sci_025 pi_1024 ;;




(** 
minus_quarter_pi_1024
 *)


let minus_quarter_pi_1024 = mult_1024 sci_025 minus_pi_1024 ;;




(** 
quarter_ipi_1024
 *)


let quarter_ipi_1024 = mult_1024 sci_025 ipi_1024 ;;




(** 
minus_quarter_ipi_1024
 *)


let minus_quarter_ipi_1024 = mult_1024 sci_025 minus_ipi_1024 ;;




(** 
e_1024
 *)


let e_1024 = format_1024 [| Data.Classical.num_e_1024 ; num_0 ; num_0 |] ;;




(** 
minus_e_1024
 *)


let minus_e_1024 = opp e_1024 ;;




(** 
log_2_1024
 *)


let log_2_1024 = format_1024 [| Data.Classical.num_log_2_1024 ; num_0 ; num_0 |] ;;




(** 
log_10_1024
 *)


let log_10_1024 = format_1024 [| Data.Classical.num_log_10_1024 ; num_0 ; num_0 |] ;;




(** 
integer_part_1024 number
 *)


let integer_part_1024 = function (x:Num.num array) ->

 if Num.ge_num x.(2) num_1024 then failwith "Not an acceptable number in Sci.integer_part_1024." ;

 if Num.lt_num x.(2) num_0 then

  sci_0

 else

  begin

   let factor = Num.power_num num_2 x.(2) in

    let xx = Num.mult_num factor x.(0)

    and yy = Num.mult_num factor x.(1) in

     format_1024 [| Num.integer_num xx ; Num.integer_num yy ; num_0 |]

  end ;;




(** 
round_1024 number
 *)


let round_1024 = function (x:Num.num array) ->

 if Num.ge_num x.(2) num_1024 then failwith "Not an acceptable number in Sci.round_1024." ;

 if Num.lt_num x.(2) num_0 then

  sci_0

 else

  begin

   let factor = Num.power_num num_2 x.(2) in

    let xx = Num.mult_num factor x.(0)

    and yy = Num.mult_num factor x.(1) in

     format_1024 [| Util.round_num xx ; Util.round_num yy ; num_0 |]

  end ;;




(** 
fractional_part_1024 number
 *)


let fractional_part_1024 = function (x:Num.num array) ->

 let xx = integer_part_1024 x in

  minus_1024 x xx ;;




(** 
th_threshold
 *)


let th_threshold = 511.5 *. ( log 2. ) ;;




(** 
quadruple_th_real
 *)


let quadruple_th_real = function (x:Num.num array) ->

 let yy = mult x x

 and y4 = [| x.(0) ; num_0 ; Num.add_num num_2 x.(2) |] in

  let y_y = plus yy sci_1

  and yy4 = [| yy.(0) ; num_0 ; Num.add_num num_2 yy.(2) |] in

   let yyy = mult y_y y_y

   and n = mult y4 y_y in

    let d = plus yyy yy4 in

     try

      div_1024 n d

     with Failure unknown -> sci_0 ;;




(** 
quadruple_tan_real
 *)


let quadruple_tan_real = function (x:Num.num array) ->

 let yy = mult x x

 and y4 = [| x.(0) ; num_0 ; Num.add_num num_2 x.(2) |] in

  let y_y = minus sci_1 yy

  and yy4 = [| yy.(0) ; num_0 ; Num.add_num num_2 yy.(2) |] in

   let yyy = mult y_y y_y

   and n = mult y4 y_y in

    let d = minus yyy yy4 in

     try

      div_1024 n d

     with Failure unknown -> sci_0 ;;






(** Some of the following functions make use of a threshold.
The value of the threshold acts upon the speed and the precision of the calculus.
A good value for the threshold may be between 0.01 and 1e-6.



Certaines des fonctions suivantes utilisent un seuil.
La valeur du seuil influence la vitesse et la précision du calcul.
Une bonne valeur pour le seuil peut être entre 0.01 et 1e-6. *)





(** The two following functions have mutually recursive definitions.



les deux fonctions qui suivent ont des définitions mutuellement récursives. *)





(** 
th_of_real_1024 threshold number
 *)


let rec th_of_real_1024 = fun (threshold:float) (x:Num.num array) ->

 if Num.lt_num x.(0) num_0 then

  opp ( th_of_real_1024 threshold ( opp x ) )

 else

  begin

   let greater_than_threshold = ( complex_of_sci x ).(0).(0) >= th_threshold

   and seuil = abs_float threshold in

    match greater_than_threshold with

    | true -> sci_1

    | false ->

     begin

      if ( complex_of_sci x ).(0).(0) >= seuil then

       begin

        let y = th_of_real_1024 threshold [| x.(0) ; num_0 ; Num.add_num num_minus_2 x.(2) |] in

         quadruple_th_real y

       end

      else

       begin

        let y = expm1_1024 [| Num.minus_num x.(0) ; num_0 ; Num.succ_num x.(2) |] in

         let yy = plus sci_2 y in

           div_1024 ( opp y ) yy

       end

    end

  end




(** 
expm1_1024 number
 *)


and expm1_1024 = function (x:Num.num array) ->

 let xx = ref ( complex_of_sci x ).(0)

 and shift = ref x

 and i = ref num_1

 and result = ref sci_0

 and gauge = ref 1 in

  while !gauge >= 0 do

   result := plus !result !shift ;

   Num.incr_num i ;

   shift := div_1024 ( mult x !shift ) ( sci_of_num !i ) ;

   xx := ( complex_of_sci [| !shift.(0) ; !shift.(1) ; Num.add_num num_3 !shift.(2) |] ).(0) ;

   gauge := compare ( ( abs_float !xx.(0) ) +. ( abs_float !xx.(1) ) ) min_float ;

  done ;

  format_1024 !result ;;




(** 
tan_of_real_1024 threshold number
 *)


let rec tan_of_real_1024 = fun (threshold:float) (x:Num.num array) ->

 let xx = real_part x

 and seuil = abs_float threshold in

  let q = integer_part_1024 ( div xx pi_1024 ) in

   let x_x = minus x ( mult q pi_1024 ) in

    if Num.lt_num x_x.(0) num_0 then

     opp ( tan_of_real_1024 threshold ( opp x_x ) )

    else

     begin

      if real_part_compare_1024 x_x half_pi_1024 = 0 then failwith "Infinity" ;

      if ( complex_of_sci x_x ).(0).(0) >= seuil then

       begin

        let y = tan_of_real_1024 threshold [| x_x.(0) ; num_0 ; Num.add_num num_minus_2 x_x.(2) |] in

         quadruple_tan_real y

       end

      else

       begin

        let y = expm1_1024 [| num_0 ; Num.minus_num x_x.(0) ; Num.succ_num x_x.(2) |] in

         let yy = plus sci_2 y in

          div_1024 [| Num.minus_num y.(1) ; y.(0) ; y.(2) |] yy

       end

     end ;;




(** 
direct_tan_1024 threshold number
 *)


let direct_tan_1024 = fun (threshold:float) (z:Num.num array) ->

 let x = real_part z

 and y = imag_part z in

  try

   begin

    let tx = tan_of_real_1024 threshold x

    and ty = th_of_real_1024 threshold y in

     let ity = [| num_0 ; ty.(0) ; ty.(2) |] in

      let n = plus tx ity

      and d = minus sci_1 ( mult tx ity ) in

       try

        div_1024 n d

       with Failure unknown -> sci_0

   end

  with Failure "Infinity" ->

   begin

    if real_part_compare_1024 y sci_0 = 0 then failwith "Infinity" ;

    try

     div_1024 sci_i ( th_of_real_1024 threshold y )

    with

     Failure unknown -> sci_0

   end ;;




(** 
tan_1024 number
 *)


let tan_1024 = function (z:Num.num array) ->

 if eq_0_1024 z then

  sci_0

 else

  begin

   (* let t1 = direct_tan_1024 1e-2 z *)

   (* and t2 = direct_tan_1024 1e-3 z *)

   (* and t3 = direct_tan_1024 1e-4 z in *)

   let t1 = direct_tan_1024 1e-8 z

   and t2 = direct_tan_1024 1e-11 z

   and t3 = direct_tan_1024 1e-14 z in

    approx_1024 [| t1 ; t2 ; t3 |]

  end ;;




(** 
tan_dot_1024 number
 *)


let tan_dot_1024 = function (z:Num.num array) ->

 let t = tan_1024 z in

  plus_1024 sci_1 ( mult t t ) ;;




(** 
direct_th_1024 threshold number
 *)


let direct_th_1024 = fun (threshold:float) (z:Num.num array) ->

 let x = real_part z

 and y = imag_part z in

  try

   begin

    let tx = th_of_real_1024 threshold x

    and ty = tan_of_real_1024 threshold y in

     let ity = [| num_0 ; ty.(0) ; ty.(2) |] in

      let n = plus tx ity

      and d = plus sci_1 ( mult tx ity ) in

       try

        div_1024 n d

       with Failure unknown -> sci_0

   end

  with Failure "Infinity" ->

   begin

    if real_part_compare_1024 x sci_0 = 0 then failwith "Infinity" ;

    try

     inv_1024 ( th_of_real_1024 threshold x )

    with

     Failure unknown -> sci_0

   end ;;




(** 
th_1024 number
 *)


let th_1024 = function (z:Num.num array) ->

 if eq_0_1024 z then

  sci_0

 else

  begin

 (* let t1 = direct_th_1024 1e-2 z *)

 (* and t2 = direct_th_1024 1e-3 z *)

 (* and t3 = direct_th_1024 1e-4 z in *)

   let t1 = direct_th_1024 1e-8 z

   and t2 = direct_th_1024 1e-11 z

   and t3 = direct_th_1024 1e-14 z in

    approx_1024 [| t1 ; t2 ; t3 |]

  end ;;




(** 
th_dot_1024 number
 *)


let th_dot_1024 = function (z:Num.num array) ->

 let t = th_1024 z in

  minus_1024 sci_1 ( mult t t ) ;;




(** 
cos_1024 number
 *)


let cos_1024 = function (z:Num.num array) ->

 if eq_0_1024 z then

  sci_1

 else

  begin

   try

    begin

     let t = tan_1024 [| z.(0) ; z.(1) ; Num.pred_num z.(2) |] in

      let t2 = mult t t in

       let n = minus sci_1 t2

       and d = plus sci_1 t2 in

        try

         div_1024 n d

        with Failure unknown -> sci_0

    end

   with Failure "Infinity" -> sci_minus_1

  end ;;




(** 
direct_sin_1024 number
 *)


let direct_sin_1024 = function (x:Num.num array) ->

 let xx = ref ( complex_of_sci x ).(0)

 and x2 = ( mult x x)

 and shift = ref x

 and i = ref num_1

 and d = ref num_1

 and result = ref x

 and gauge = ref 1 in

  while !gauge >= 0 do

   Num.incr_num i ;

   d := Num.mult_num !d !i ;

   shift := mult x2 !shift ;

   Num.incr_num i ;

   d := Num.mult_num !d ( Num.minus_num !i ) ;

   shift := div_1024 !shift ( sci_of_num !d ) ;

   xx := ( complex_of_sci [| !shift.(0) ; !shift.(1) ; Num.add_num num_3 !shift.(2) |] ).(0) ;

   gauge := compare ( ( abs_float !xx.(0) ) +. ( abs_float !xx.(1) ) ) min_float ;

   result := plus_1024 !result !shift ;

  done ;

  !result ;;




(** 
sin_1024 number
 *)


let sin_1024 = function (z:Num.num array) ->

 if eq_0_1024 z then

  sci_0

 else

  begin

   let test = complex_of_sci z in

    if log ( abs_float test.(0).(0) +. abs_float test.(0).(1) ) < -3. then

     direct_sin_1024 z

    else

     try

      begin

       let t = tan_1024 [| z.(0) ; z.(1) ; Num.pred_num z.(2) |] in

        let t2 = mult t t in

         let n = mult sci_2 t

         and d = plus sci_1 t2 in

          try

           div_1024 n d

          with Failure unknown -> sci_0

      end

     with Failure "Infinity" -> sci_0

  end ;;




(** 
ch_1024 number
 *)


let ch_1024 = function (z:Num.num array) ->

 if eq_0_1024 z then

  sci_1

 else

  begin

   try

    begin

     let t = th_1024 [| z.(0) ; z.(1) ; Num.pred_num z.(2) |] in

      let t2 = mult t t in

       let n = plus sci_1 t2

       and d = minus sci_1 t2 in

        try

         div_1024 n d

        with Failure unknown -> sci_0

    end

   with Failure "Infinity" -> sci_minus_1

  end ;;




(** 
direct_sh_1024 number
 *)


let direct_sh_1024 = function (x:Num.num array) ->

 let xx = ref ( complex_of_sci x ).(0)

 and x2 = ( mult x x)

 and shift = ref x

 and i = ref num_1

 and d = ref num_1

 and result = ref x

 and gauge = ref 1 in

  while !gauge > 0 do

   Num.incr_num i ;

   d := Num.mult_num !d !i ;

   shift := mult x2 !shift ;

   Num.incr_num i ;

   d := Num.mult_num !d !i ;

   shift := div_1024 !shift ( sci_of_num !d ) ;

   xx := ( complex_of_sci [| !shift.(0) ; !shift.(1) ; Num.add_num num_3 !shift.(2) |] ).(0) ;

   gauge := compare ( ( abs_float !xx.(0) ) +. ( abs_float !xx.(1) ) ) min_float ;

   result := plus_1024 !result !shift ;

  done ;

  !result ;;




(** 
sh_1024 number
 *)


let sh_1024 = function (z:Num.num array) ->

 if eq_0_1024 z then

  sci_0

 else

  begin

   let test = complex_of_sci z in

    if log ( abs_float test.(0).(0) +. abs_float test.(0).(1) ) < -3. then

     direct_sh_1024 z

    else

     try

      begin

       let t = th_1024 [| z.(0) ; z.(1) ; Num.pred_num z.(2) |] in

        let t2 = mult t t in

         let n = mult sci_2 t

         and d = minus sci_1 t2 in

          try

           div_1024 n d

          with Failure unknown -> sci_0

      end

     with Failure "Infinity" -> sci_0

  end ;;




(** 
exp_1024 number
 *)


let exp_1024 = function (z:Num.num array) ->

 if eq_0_1024 z then

  sci_1

 else

  begin

   let test = complex_of_sci z in

    if log ( abs_float test.(0).(0) +. abs_float test.(0).(1) ) < -3. then

     plus_1024 sci_1 ( expm1_1024 z )

    else

     try

      begin

       let t = th_1024 [| z.(0) ; z.(1) ; Num.pred_num z.(2) |] in

        let n = plus sci_1 t

        and d = minus sci_1 t in

         try

          div_1024 n d

         with Failure unknown -> sci_0

      end

     with Failure "Infinity" -> sci_minus_1

  end ;;




(** cotan_1024 number *)


let cotan_1024 = function (x:Num.num array) ->

 let t = ref sci_1

 and annihilate = ref false in

  begin

   try

    t := tan_1024 x

   with Failure "Infinity" -> ( annihilate := true )

  end ;

  if eq_0_1024 !t then failwith "Infinity" ;

  if !annihilate then

   sci_0

  else

   begin

    try

     inv_1024 !t

    with Failure unknown -> failwith "Infinity"

   end ;;




(** sec_1024 number *)


let sec_1024 = function (x:Num.num array) ->

 let c = ref sci_1

 and annihilate = ref false in

  begin

   try

    c := cos_1024 x

   with Failure "Infinity" -> ( annihilate := true )

  end ;

  if eq_0_1024 !c then failwith "Infinity" ;

  if !annihilate then

   sci_0

  else

   begin

    try

     inv_1024 !c

    with Failure unknown -> failwith "Infinity"

   end ;;




(** sech_1024 number *)


let sech_1024 = function (x:Num.num array) ->

 let c = ref sci_1

 and annihilate = ref false in

  begin

   try

    c := ch_1024 x

   with Failure "Infinity" -> ( annihilate := true )

  end ;

  if eq_0_1024 !c then failwith "Infinity" ;

  if !annihilate then

   sci_0

  else

   begin

    try

     inv_1024 !c

    with Failure unknown -> failwith "Infinity"

   end ;;




(** cosec_1024 number *)


let cosec_1024 = function (x:Num.num array) ->

 let s = ref sci_1

 and annihilate = ref false in

  begin

   try

    s := sin_1024 x

   with Failure "Infinity" -> ( annihilate := true )

  end ;

  if eq_0_1024 !s then failwith "Infinity" ;

  if !annihilate then

   sci_0

  else

   begin

    try

     inv_1024 !s

    with Failure unknown -> failwith "Infinity"

   end ;;




(** cosech_1024 number *)


let cosech_1024 = function (x:Num.num array) ->

 let s = ref sci_1

 and annihilate = ref false in

  begin

   try

    s := sh_1024 x

   with Failure "Infinity" -> ( annihilate := true )

  end ;

  if eq_0_1024 !s then failwith "Infinity" ;

  if !annihilate then

   sci_0

  else

   begin

    try

     inv_1024 !s

    with Failure unknown -> failwith "Infinity"

   end ;;






(** The algorithm of the arithmetic and geometric means comes from the pages 15 and 16 of the document log2.ps
at the following address.



http://numbers.computation.free.fr/Constants/constants.html



L'algorithme de la moyenne arithmétique et géométrique provient des pages 15 et 16
du document log2.ps à l'adresse précédente. *)





(** 
agm_1024 vector
 *)


let agm_1024 = fun (z:Num.num array array) ->

 let x = z.(0)

 and y = z.(1) in

  let s = plus_1024 x y in

   [| [| s.(0) ; s.(1) ; Num.pred_num s.(2) |] ; sqrt_1024 ( mult x y ) |] ;;




(** agm_sum_1024 vector *)


let agm_sum_1024 = fun (z:Num.num array array) ->

 let zz = ref z

 and i = ref num_minus_1

 and f = fun x y -> ( abs_float x ) +. ( abs_float y )

 and z_z = ref ( minus ( mult z.(0) z.(0) ) ( mult z.(1) z.(1) ) ) in

  let error = ref ( complex_of_sci [| !z_z.(0) ; !z_z.(1) ; Num.add_num num_5 !z_z.(2) |] )

  and zzz = ref [| !z_z.(0) ; !z_z.(1) ; Num.pred_num !z_z.(2) |] in

   let result = ref !zzz in

    while f !error.(0).(0) !error.(0).(1) > 32. *. min_float do

     Num.incr_num i ;

     zz := agm_1024 !zz ;

     z_z := minus ( mult !zz.(0) !zz.(0) ) ( mult !zz.(1) !zz.(1) ) ;

     zzz := [| !z_z.(0) ; !z_z.(1) ; Num.add_num !i !z_z.(2) |] ;

     error := complex_of_sci [| !zzz.(0) ; !zzz.(1) ; Num.add_num num_6 !zzz.(2) |] ;

     result := plus !result !zzz ;

   done ;

   format_1024 !result ;;




(** 
agm_log_1024 number
 *)


let agm_log_1024 = function (z:Num.num array) ->

 let factor = [| num_1 ; num_0 ; Num.num_of_int ( -514 ) |] in

  let s1 = agm_sum_1024 [| sci_1 ; factor |]

  and sz = agm_sum_1024 [| sci_1 ; ( mult factor z ) |] in

   let r1 = minus sci_1 s1

   and rz = minus sci_1 sz in

    let n = minus s1 sz

    and d = mult r1 rz in

     div_1024 n d ;;




(** 
log1p_1024
 *)


let log1p_1024 = function (z:Num.num array) ->

 if eq_0_1024 z then

  sci_0

 else

  begin

   let error = ref ( complex_of_sci z )

   and i = ref num_2

   and coefficient = ref sci_0

   and sign = ref true

   and f = fun x y -> ( abs_float x ) +. ( abs_float y )

   and puissance = ref ( mult z z )

   and result = ref z in

    while f !error.(0).(0) !error.(0).(1) > min_float do

     coefficient := div !puissance [| !i ; num_0 ; num_0 |] ;

     if !sign then

      result := minus !result !coefficient

     else

      result := plus !result !coefficient ;

     Num.incr_num i ;

     sign := not !sign ;

     puissance := mult z !puissance ;

     error := complex_of_sci [| !coefficient.(0) ; !coefficient.(1) ; Num.add_num num_3 !coefficient.(2) |] ;

    done ;

    format_1024 !result

  end ;;




(** 
direct_log_1024 threshold number
 A good threshold is -100.



Un bon seuil est -100. *)


let direct_log_1024 = fun (threshold:float) (z:Num.num array) ->

 let diff = minus z sci_1 in

  let float_diff = complex_of_sci diff in

   if log ( abs_float float_diff.(0).(0) +. abs_float float_diff.(0).(1) ) < threshold then

    log1p_1024 diff

   else

    let x = agm_log_1024 [| z.(0) ; z.(1) ; num_minus_1 |]

    and y = mult log_2_1024 [| Num.succ_num z.(2) ; num_0 ; num_0 |] in

     plus_1024 x y ;;




(** 
log_1024 number
 *)


let log_1024 = function (z:Num.num array) ->

 let y = direct_log_1024 ( -100. ) z in

  let x = exp_1024 y

  and w0 = plus y sci_minus_1 in

   let w1 = div z x in

    let yy = plus w0 w1 in

     let xx = exp_1024 yy

     and w2 = plus yy sci_minus_1 in

      let w3 = div z xx in

       let yyy = plus w2 w3 in

        approx_1024 [| y ; yy ; yyy |] ;;




(** 
tune_arg function derivative argument candidate
 *)


let tune_arg = fun f fdot (x:Num.num array) (y:Num.num array) ->

 let z = minus_1024 ( f y ) x

 and zz = fdot y in

  minus_1024 y ( div z zz ) ;;




(** 
adapt_arg steps threshold function derivative argument candidate
 *)


let adapt_arg = fun (steps:int) (threshold:float) f fdot (x:Num.num array) (y:Num.num array) ->

 let nouveau = ref ( tune_arg f fdot x y )

 and i = ref 0

 and ancien = ref y in

  let error = ref ( complex_of_sci ( minus !nouveau !ancien ) ).(0) in

   while ( !i < steps ) && ( ( abs_float !error.(0) +. abs_float !error.(1) ) > threshold ) do

    ancien := !nouveau ;

    nouveau := tune_arg f fdot x !nouveau ;

    error := ( complex_of_sci ( minus !nouveau !ancien ) ).(0);

    incr i ;

   done ;

   !nouveau ;;




(** 
argth_1024 number
 *)


let argth_1024 = function (z:Num.num array) ->

 if ( eq_0_1024 ( plus_1024 z sci_minus_1 ) ) || ( eq_0_1024 ( plus_1024 z sci_1 ) ) then

  failwith "Infinity" ;

 if eq_0_1024 z then

  sci_0

 else

  begin

   let test = complex_of_sci z in

    if log ( abs_float test.(0).(0) +. abs_float test.(0).(1) ) < -3. then

     adapt_arg 100 ( 16. *. min_float ) th_1024 th_dot_1024 z z

    else

     let n = plus sci_1 z

     and d = minus sci_1 z in

      try

       begin

        let q = div n d in

         let y = log_1024 q in

          [| y.(0) ; y.(1) ; Num.pred_num y.(2) |]

       end

      with Failure unknown -> failwith "Infinity"

  end ;;




(** 
argch_1024 number
 *)


let argch_1024 = function (z:Num.num array) ->

 let diff = minus z sci_1 in

  if eq_0_1024 diff then

   sci_0

  else

   begin

    let float_test = complex_of_sci diff in

     if log ( abs_float float_test.(0).(0) +. abs_float float_test.(0).(1) ) < -3. then

      adapt_arg 100 ( 16. *. min_float ) ch_1024 sh_1024 z ( sqrt_1024 ( mult sci_2 diff ) )

     else

      let zz = mult z z in

       let s = sqrt_1024 ( plus zz sci_minus_1 ) in

        log_1024 ( plus z s )

   end ;;




(** 
direct_argsh_1024 steps number
 *)


let direct_argsh_1024 = fun (steps:int) (x:Num.num array) ->

 let xx = ref ( complex_of_sci x ).(0)

 and x2 = ( mult x x)

 and shift = ref x

 and power = ref x

 and accu = ref num_1

 and factor = ref num_1

 and i = ref num_0

 and d = ref num_1

 and result = ref x

 and gauge = ref 1 in

  while ( !gauge > 0 ) && ( Num.int_of_num !i < steps ) do

   Num.incr_num i ;

   d := Num.succ_num ( Num.mult_num num_2 !i ) ;

   accu := Num.mult_num !accu ( Num.div_num ( Num.add_num !i num_minus_05 ) ( Num.minus_num !i ) ) ;

   factor := Num.div_num !accu !d ;

   power := mult_1024 x2 !power ;

   shift := mult !power ( sci_of_num !factor ) ;

   xx := ( complex_of_sci [| !shift.(0) ; !shift.(1) ; Num.add_num num_3 !shift.(2) |] ).(0) ;

   gauge := compare ( ( abs_float !xx.(0) ) +. ( abs_float !xx.(1) ) ) min_float ;

   result := plus_1024 !result !shift ;

  done ;

  !result ;;




(** 
argsh_1024 number
 *)


let argsh_1024 = function (z:Num.num array) ->

 if eq_0_1024 z then

  sci_0

 else

  begin

   let test = complex_of_sci z in

    if log ( abs_float test.(0).(0) +. abs_float test.(0).(1) ) < -3. then

     adapt_arg 100 ( 16. *. min_float ) sh_1024 ch_1024 z ( direct_argsh_1024 2 z )

    else

     let zz = mult z z in

      let s = sqrt_1024 ( plus zz sci_1 ) in

       log_1024 ( plus z s )

  end ;;




(** 
arctan_1024 number
 *)


let arctan_1024 = function (z:Num.num array) ->

 if eq_0_1024 z then

  sci_0

 else

  begin

   let zz = mult sci_minus_i z in

    mult_1024 sci_i ( argth_1024 zz )

  end ;;




(** 
direct_arcsin_1024 steps number
 *)


let direct_arcsin_1024 = fun (steps:int) (x:Num.num array) ->

 let xx = ref ( complex_of_sci x ).(0)

 and x2 = ( mult_1024 x x)

 and shift = ref x

 and power = ref x

 and accu = ref num_1

 and factor = ref num_1

 and i = ref num_0

 and d = ref num_1

 and result = ref x

 and gauge = ref 1 in

  while ( !gauge >= 0 ) && ( Num.int_of_num !i < steps ) do

   Num.incr_num i ;

   d := Num.succ_num ( Num.mult_num num_2 !i ) ;

   accu := Num.mult_num !accu ( Num.div_num ( Num.add_num !i num_minus_05 ) !i ) ;

   factor := Num.div_num !accu !d ;

   power := mult x2 !power ;

   shift := mult !power ( sci_of_num !factor ) ;

   xx := ( complex_of_sci [| !shift.(0) ; !shift.(1) ; Num.add_num num_3 !shift.(2) |] ).(0) ;

   gauge := compare ( ( abs_float !xx.(0) ) +. ( abs_float !xx.(1) ) ) min_float ;

   result := plus !result !shift ;

  done ;

  !result ;;




(** 
arcsin_1024 number
 *)


let arcsin_1024 = function (z:Num.num array) ->

 if eq_0_1024 z then

  sci_0

 else

  begin

   let test = complex_of_sci z in

    if log ( abs_float test.(0).(0) +. abs_float test.(0).(1) ) < -3. then

     adapt_arg 100 ( 16. *. min_float ) sin_1024 ( function x -> sci_1 ) z ( direct_arcsin_1024 2 z )

    else

     let zz = mult sci_minus_i z in

      mult_1024 sci_i ( argsh_1024 zz )

  end ;;




(** 
arccos_1024 number
 *)


let arccos_1024 = function (z:Num.num array) ->

 let zz = argch_1024 z in

  mult_1024 sci_minus_i zz ;;




(** 
arcsec_1024 number
 *)


let arcsec_1024 = function (z:Num.num array) ->

 arccos_1024 ( inv z ) ;;




(** 
argsech_1024 number
 *)


let argsech_1024 = function (z:Num.num array) ->

 argch_1024 ( inv z ) ;;




(** 
arccosec_1024 number
 *)


let arccosec_1024 = function (z:Num.num array) ->

 arcsin_1024 ( inv z ) ;;




(** 
argcosech_1024 number
 *)


let argcosech_1024 = function (z:Num.num array) ->

 argsh_1024 ( inv z ) ;;




(** 
arccotan_1024 number
 *)


let arccotan_1024 = function (z:Num.num array) ->

 arctan_1024 ( inv z ) ;;




(** 
arccoth_1024 number
 *)


let argcoth_1024 = function (z:Num.num array) ->

 argth_1024 ( inv z ) ;;
















(** 
§ § § 
 *)










end



  





module Reduc = struct










(** 
§ 
 *)



(** 

Introduction

*)



(** 
 
 *)







(**
The mathematician will find in this module methods in order to:



    

  • calculate with univariate polynomials with real or complex coefficients,
    • 



    

  • calculate with complex matrices,
    • 



    

  • calculate with polynomials of matrices,
    • 



    

  • approximate eigenvalues and eigenvectors of matrices,
    • 



    

  • separate nilpotent and diagonalizable parts of a matrix,
    • 



    

  • approximate roots of polynomials.
    • 



Various tradeoffs between speed and presision are possible.
Some calculus in extended precision necessitate the module sci.ml which depends on the module nums.cma from the standard Ocaml distribution.




Conventions




Univariate polynomial are line-vectors (see the module  matrix.ml) containing the coefficients.
The coefficients are taken in the basis (X^i), for i natural integer.



Complex numbers are square matrices of order 2 with coefficients of type float of the form



[| [| x ; -y |] ;

 [| y ; x|] |]. ***



Complex matrices are real matrices of quadruple size orgnized as before where x and y represent respectively
the real and imaginary parts.



Complex vectors may be represented by double-size float vectors with imaginary part coming in the second half.
They may be represented too by real matrices with two columns as before *** or by complex polynomials.



Complex polynomials are arrays of complex numbers.



Some translating functions with the type Complex.t of Ocaml are provided, 
and functions applying functions of the Complex module of Ocaml (like Complex.exp or Complex.arg) are provided too.



Gauss integers are square matrices of order 2 with coefficients of type int with the same form ***.



The degree and valuation of a polynomial are of type float in order to ease the arithmetic with infinity.




Comments




The Jordan decomposition algorithm is described in:



www.lsv.ens-cachan.fr/~picaro/COURS/MG/DIVERS/dunford.pdf



The approximating seek of the roots of a polynomial may produce a failure if:



    

  • some distinct roots are close of one another,
    • 

  • the multiplicities are high,
    • 

  • the degree of the polynomial is high.
    • 



The combination of all these factors increases the difficulty. 



A shifted seek of the eigenvalues may enhance the results.



This module is distributed under the same licence as Ocaml.




§ 




La mathématicienne ou le mathématicien trouvera dans ce module des méthodes pour :



    

  • calculer avec des polynômes à une variable à coefficients réels ou complexes,
    • 



    

  • calculer avec des matrices complexes,
    • 



    

  • calculer avec des polynômes de matrices,
    • 



    

  • approximer des valeurs et vecteurs propres de matrices,
    • 



    

  • séparer parties nilpotente et diagonalisable d'une matrice,
    • 



    

  • approximer des racines de polynômes.
    • 



Différents compromis entre vitesse et précision sont possibles.
Certains calculs en précision étendue font appel au module sci.ml qui dépend du module nums.cma de la distribution Ocaml normale.




Conventions




Les polynômes à une variable sont des vecteurs lignes (confer le module  matrix.ml) qui contiennent les coefficients.
Les coefficients sont dans la base (X^i), pour i entier naturel.



Les nombres complexes sont des matrices carrées d'ordre 2 à coefficients de type float, sous la forme



[| [| x ; -y |] ;

 [| y ; x|] |]. ***



Les matrices complexes sont des matrices réelles de taille quadruple organisées comme ci-dessus où x et y
représentent respectivement les parties réelle et complexe.



Les vecteurs complexes peuvent être représentés par des vecteurs réels de taille double dont la partie imaginaire vient dans la deuxième moitié.
Ils peuvent aussi être représentés par des matrices réelles à deux colonnes comme ci-dessus *** ou comme des polynômes complexes.



Les polynômes complexes sont des tableaux de nombres complexes.



Des fonctions de traduction avec le type Complex.t d'Ocaml sont fournies, 
et aussi des fonctions d'application des fonctions du module Complex (comme Complex.exp ou Complex.arg).



Les entiers de Gauss sont des matrices carrées d'ordre 2 à coefficients de type int sous la même forme ***.



Les degré et valuation d'un polynôme sont de type float pour faciliter l'arithmétique avec l'infini.




Commentaires




L'algorithme de décomposition de Jordan est décrit dans :



www.lsv.ens-cachan.fr/~picaro/COURS/MG/DIVERS/dunford.pdf



La recherche approchée des racines d'un polynôme peut être mise en échec si : 



    

  • des racines distinctes sont proches,
    • 

  • les multiplicités sont élevées, 
    • 

  • le degré du polynôme est élevé. 
    • 



La combinaison de ces facteurs augmente encore la difficulté. 



Une recherche avec décalage (shift) des valeurs propres peut améliorer les résultats.



Ce module est distribué selon la même licence qu'Ocaml.




Copyright Stéphane Grognet 


Laboratoire de mathématiques Jean Leray UMR 6629 CNRS 


Fédération de recherche mathématique des Pays de la Loire 


IREM des Pays de la Loire - Université de Nantes 


version 0.4

*)



(**
@version 0.4
*)



(**
@author Stéphane Grognet
*)



(**
@since 2011, 2012, 2013
*)










open Util ;;

open Matrix ;;

open Sci ;;










(** 
§ 
 *)



(** 

Constructions élémentaires


Elementary constructions

*)



(** 
 
 *)











(** 

Complexes

*)



(** 
 
 *)











(** 
built_in_complex_to_matrix complex
 *)


let built_in_complex_to_matrix = function (z:Complex.t) ->

 let x = z.Complex.re

 and y = z.Complex.im in

  [| [| x ; -. y |] ; [| y ; x |] |] ;;




(** 
apply_built_in_complex_to_matrix function complex
 *)


let apply_built_in_complex_to_matrix = fun (f:Complex.t -> Complex.t) (z:float array array) ->

 let zz = { Complex.re = z.(0).(0) ; Complex.im = z.(1).(0) } in

  let zzz = f zz in

   let x = zzz.Complex.re

   and y = zzz.Complex.im in

    [| [| x ; -. y |] ; [| y ; x |] |] ;;




(** 
apply_built_in_complex_float_to_matrix function complex
 *)


let apply_built_in_complex_float_to_matrix = fun (f:Complex.t -> float) (z:float array array) ->

 let zz = { Complex.re = z.(0).(0) ; Complex.im = z.(1).(0) } in

  f zz ;;




(** 
polar_to_matrix modulus argument
 *)


let polar_to_matrix = fun (r:float) (t:float) ->

 let x = r *. ( cos t )

 and y = r *. ( sin t ) in

  [| [| x ; -. y |] ; [| y ; x |] |] ;;




(** 
apply2_built_in_complex_to_matrix function complex1 complex2
 *)


let apply2_built_in_complex_to_matrix = fun (f:Complex.t -> Complex.t -> Complex.t) (z:float array array) (w:float array array) ->

 let zz = { Complex.re = z.(0).(0) ; Complex.im = z.(1).(0) }

 and ww = { Complex.re = w.(0).(0) ; Complex.im = w.(1).(0) } in

  let zzz = f zz ww in

   let x = zzz.Complex.re

   and y = zzz.Complex.im in

    [| [| x ; -. y |] ; [| y ; x |] |] ;;




(** 
float_to_complex float
 *)


let float_to_complex = function (x:float) ->

[| [| x ; 0. |] ; [| 0. ; x |] |] ;;




(** 
int_to_complex float
 *)


let int_to_complex = function (x:int) ->

[| [| float x ; 0. |] ; [| 0. ; float x |] |] ;;




(** 
clean_complex complex
 *)


let clean_complex = function (z:float array array) ->

 let a = z.(0).(0)

 and b = z.(1).(0)

 and c = z.(0).(1)

 and d = z.(1).(1) in

  let x = 0.5 *. ( a +. d )

  and y = 0.5 *. ( b -. c ) in

   [| [| x ; -. y |] ; [| y ; x |] |] ;;




(** 
complex_inv_bis complex
 *)


let complex_inv_bis = function (z:float array array) ->

 ( Matrix.float_tune_inv Matrix.matrix_float_norm_inf z ( Matrix.float_inv z ) ).(0) ;;




(** 
complex_inv_ter parameter complex
 *)


let complex_inv_ter = fun (parameter:float) (z:float array array) ->

 let y0 = built_in_complex_to_matrix ( Complex.inv {Complex.re=z.(0).(0) ; Complex.im=z.(1).(0)} )

 and y1 = complex_inv_bis z in

  Matrix.matrix_float_plus ( clean_complex y1 ) ( clean_complex ( Matrix.matrix_float_scal_mult parameter ( Matrix.matrix_float_minus y1 y0 ) ) ) ;;




(** 
complex_inv complex
 *)


let complex_inv = function (z:float array array) -> complex_inv_ter 2. z ;;




(** 
complex_slow_inv complex
 *)


let complex_slow_inv = function (z:float array array) ->

 ( Matrix.float_target_inv Matrix.matrix_float_norm_frobenius complex_inv 0. z ).(0) ;;




(** 
complex_div complex1 complex2
 *)


let complex_div = fun (z:float array array) (zz:float array array) ->

 Matrix.matrix_float_prod ( complex_inv zz ) z ;;






(** 
complex_module complex
 This function permits to measurate the errors when getting away from the
complex structure because of the cumulated errors on the matrix computing.



Cette fonction permet de mesurer les erreurs quand on s'éloigne de la structure complexe
à cause des erreurs cumulées sur les calculs de matrices. *)


let complex_module = function (z:float array array) ->

 let a = z.(0).(0)

 and b = z.(1).(0)

 and c = z.(0).(1)

 and d = z.(1).(1) in

 sqrt ( 0.5 *. ( a *. a +. b *. b +. c *. c +. d *. d ) ) ;;






(** 
complex_square_module complex
 This function permits to measurate the errors when getting away from the
complex structure because of the cumulated errors on the matrix computing.



Cette fonction permet de mesurer les erreurs quand on s'éloigne de la structure complexe
à cause des erreurs cumulées sur les calculs de matrices. *)


let complex_square_module = function (z:float array array) ->

 let a = z.(0).(0)

 and b = z.(1).(0)

 and c = z.(0).(1)

 and d = z.(1).(1) in

  0.5 *. ( a *. a +. b *. b +. c *.c +. d *. d ) ;;




(** 
complex_abs_max complex
 *)


let complex_abs_max = function (z:float array array) ->

 let a = abs_float z.(0).(0)

 and b = abs_float z.(1).(0)

 and c = abs_float z.(0).(1)

 and d = abs_float z.(1).(1) in

  Matrix.vector_float_max [| a ; b ; c ; d |] ;;




(** 
complex_abs_sum complex
 *)


let complex_abs_sum = function (z:float array array) ->

 let a = abs_float z.(0).(0)

 and b = abs_float z.(1).(0)

 and c = abs_float z.(0).(1)

 and d = abs_float z.(1).(1) in

  0.5 *. ( a +. b +. c +. d ) ;;






(** 
complex_real_part complex
 *)


let complex_real_part = function (z:float array array) ->

 let a = z.(0).(0)

 and d = z.(1).(1) in

  0.5 *. ( a +. d ) ;;




(** 
complex_imaginary_part complex
 *)


let complex_imaginary_part = function (z:float array array) ->

 let b = z.(1).(0)

 and c = z.(0).(1) in

  0.5 *. ( b -. c ) ;;




(** 
complex_solve_degree_2 a b c
 *)


let complex_solve_degree_2 = fun (a:float array array) (b:float array array) (c:float array array) ->

 let bb = Matrix.matrix_float_prod b ( float_to_complex (-0.5) ) in

  let d = Matrix.matrix_float_minus ( Matrix.matrix_float_prod bb bb ) ( Matrix.matrix_float_prod a c ) in

   if complex_square_module d = 0. then

    begin

     let x = complex_div bb a in

      [| x ; x |]

    end

   else

    begin

     let dd = apply_built_in_complex_to_matrix Complex.sqrt d in

      let m = Matrix.matrix_float_minus bb dd

      and p = Matrix.matrix_float_plus bb dd in

       let mm = complex_square_module m

       and pp = complex_square_module p in

        if pp >= mm then 

         begin

          let x = complex_div p a in

           [| x ; complex_div c p |]

         end

        else

         begin

          let x = complex_div m a in

           [| complex_div c m ; x |]

         end

    end ;;




(** 
largo_complex_solve_degree_2 a b c
 *)


let largo_complex_solve_degree_2 = fun (a:float array array) (b:float array array) (c:float array array) ->

 Array.map Sci.complex_of_sci ( Sci.solve_degree_2_1024 ( Sci.sci_of_complex a ) ( Sci.sci_of_complex b ) ( Sci.sci_of_complex c ) ) ;;






(** 
complex_trace matrix
 *)


let complex_trace = function (m: float array array) ->

 let mm = Matrix.matrix_float_cut 2 m in

  let mmm = Matrix.matrix_foa_demakeup mm.(0) in

   let t = Matrix.float_demakeup ( Matrix.foa_trace mmm.(0).(0) )

   and tt = Matrix.float_demakeup ( Matrix.foa_trace mmm.(1).(0) ) in

    [| [| t ; -. tt |] ; [| tt ; t |] |] ;;




(** 
matrix_complex_real_part matrix
 *)


let matrix_complex_real_part = function (m:float array array) ->

 let rrrr = Array.length m

 and cccc = Array.length m.(0) in

  let rr = rrrr / 2

  and cc = cccc / 2

  and rrr = rrrr - 1

  and ccc = cccc - 1 in

   let r = rr - 1

   and c = cc - 1 in

   let x = Matrix.sub_matrix m 0 r 0 c

   and xx = Matrix.sub_matrix m r rrr cc ccc in

    Matrix.matrix_float_scal_mult 0.5 ( Matrix.matrix_float_plus x xx ) ;;




(** 
matrix_complex_imag_part matrix
 *)


let matrix_complex_imag_part = function (m:float array array) ->

 let rrrr = Array.length m

 and cccc = Array.length m.(0) in

  let rr = rrrr / 2

  and cc = cccc / 2

  and rrr = rrrr - 1

  and ccc = cccc - 1 in

   let r = rr - 1

   and c = cc - 1 in

   let y = Matrix.sub_matrix m rr rrr 0 c

   and yy = Matrix.sub_matrix m 0 r cc ccc in

    Matrix.matrix_float_scal_mult 0.5 ( Matrix.matrix_float_minus y yy ) ;;




(** 
matrix_complexify matrix1 matrix2
 *)


let matrix_complexify = fun (x:float array array) (y:float array array) ->

 let m = [| [| Matrix.Float_matrix_cons x ; Matrix.Float_matrix_cons ( Matrix.matrix_float_opp y ) |] ;

            [| Matrix.Float_matrix_cons y ; Matrix.Float_matrix_cons x |] |] in

  Matrix.matrix_float_demakeup ( Matrix.matrix_foa_crash ( Matrix.Foa_matrix_cons m ) ) ;;




(** 
complex_saturate num_rows num_columns complex
 *)


let complex_saturate = fun (r:int) (c:int) z ->

 let x = Array.make_matrix r c z.(0).(0)

 and y = Array.make_matrix r c z.(1).(0) in

  matrix_complexify x y ;;




(** 
matrix_real_to_complex matrix
 *)


let matrix_real_to_complex = function (x:float array array) ->

 let z = Matrix.zeros_float x in

  matrix_complexify x z ;;




(** 
matrix_imag_to_complex matrix
 *)


let matrix_imag_to_complex = function (x:float array array) ->

 let z = Matrix.zeros_float x in

  matrix_complexify z x ;;




(** 
scal_complex num_rows num_columns complex
 *)


let scal_complex = fun (r:int) (c:int) (z:float array array) ->

 let x = Matrix.scal_float r c z.(0).(0)

 and y = Matrix.scal_float r c z.(1).(0) in

  matrix_complexify x y ;;




(** 
matrix_complex_jordan order complex
 *)


let matrix_complex_jordan = fun (n:int) (z:float array array) ->

 let x = scal_complex n n z in

  for i = 0 to n - 2 do

   x.(i).( i + 1 ) <- 1. ;

   let nn = n + i in

    x.(nn).( nn + 1 ) <- 1. ;

  done ;

  x ;;




(** 
vector_complex_scal_mult complex polynomial
 *)


let vector_complex_scal_mult = fun (x:float array array) (v:float array array array) ->

 let l = Array.length v

 and zz = Array.make_matrix 2 2 0. in

  let vv = Array.make l zz in

   for i = 0 to l - 1 do

    vv.(i) <- Matrix.matrix_float_prod x v.(i)

   done ;

   vv ;;




(** 
vector_complex_scal_left_div complex polynomial
 *)


let vector_complex_scal_left_div = fun (x:float array array) (v:float array array array) ->

 let l = Array.length v

 and zz = Array.make_matrix 2 2 0. in

  let vv = Array.make l zz in

   for i = 0 to l - 1 do

    vv.(i) <- Matrix.matrix_float_prod ( complex_inv x ) v.(i)

   done ;

   vv ;;




(** 
vector_complex_scal_right_div complex polynomial
 *)


let vector_complex_scal_right_div = fun (x:float array array) (v:float array array array) ->

 let l = Array.length v

 and zz = Array.make_matrix 2 2 0. in

  let vv = Array.make l zz in

   for i = 0 to l - 1 do

    vv.(i) <- Matrix.matrix_float_prod x ( complex_inv v.(i) )

   done ;

   vv ;;




(** 
matrix_complex_scal_mult complex matrix
 *)


let matrix_complex_scal_mult = fun (x:float array array) (m:float array array) ->

 let l = ( Array.length m ) / 2 in

  let xx = scal_complex l l x in

   Matrix.matrix_float_prod xx m ;;




(** 
matrix_complex_scal_left_div complex matrix
 *)


let matrix_complex_scal_left_div = fun (x:float array array) (m:float array array) ->

 let l = ( Array.length m ) / 2 in

  let xx = Matrix.float_inv ( scal_complex l l x ) in

   Matrix.matrix_float_prod xx m ;;






(** 
vector_complex_norm_inf polynomial
 *)


let vector_complex_norm_inf = function (p:float array array array) ->

 let v = Array.map complex_module p in

  Matrix.vector_float_norm_inf v ;;




(** 
vector_complex_norm_inf_bis polynomial
 *)


let vector_complex_norm_inf_bis = function (p:float array array array) ->

 let v = Array.map Matrix.matrix_float_norm_inf p in

  Matrix.vector_float_norm_inf v ;;




(** 
vector_complex_norm_1 polynomial
 *)


let vector_complex_norm_1 = function (p:float array array array) ->

 let v = Array.map complex_module p in

  Matrix.vector_float_norm_1 v ;;




(** 
vector_complex_norm_1_bis polynomial
 *)


let vector_complex_norm_1_bis = function (p:float array array array) ->

 let v = Array.map Matrix.matrix_float_norm_1 p in

  Matrix.vector_float_norm_1 v ;;




(** 
vector_complex_norm_2 polynomial
 *)


let vector_complex_norm_2 = function (p:float array array array) ->

 let v = Array.map complex_module p in

  Matrix.vector_float_norm_2 v ;;




(** 
vector_complex_square_norm_2 polynomial
 *)


let vector_complex_square_norm_2 = function (p:float array array array) ->

 let v = Array.map complex_square_module p in

  Matrix.vector_float_sum v ;;










(** 

Entiers de Gauss


Gauss integers

*)



(** 
 
 *)











(** 
int_to_gauss integer
 *)


let int_to_gauss = function (x:int) ->

[| [| x ; 0 |] ; [| 0 ; x |] |] ;;




(** 
gauss_inv gauss_integer
 *)


let gauss_inv = function (z:int array array) ->

 Matrix.int_inv z ;;




(** 
gauss_div gauss_integer1 gauss_integer2
 *)


let gauss_div = fun (z:int array array) (zz:int array array) ->

 Matrix.matrix_int_prod ( gauss_inv zz ) z ;;




(** 
gauss_square_module gauss_integer
 *)


let gauss_square_module = function (z:int array array) ->

 let a = z.(0).(0)

 and b = z.(1).(0)

 and c = z.(0).(1)

 and d = z.(1).(1) in

  ( a * a + b * b + c * c + d * d ) / 2 ;;




(** 
gauss_real_part gauss_integer
 *)


let gauss_real_part = function (z:int array array) ->

 let a = z.(0).(0)

 and d = z.(1).(1) in

  ( a + d ) / 2 ;;




(** 
gauss_imaginary_part gauss_integer
 *)


let gauss_imaginary_part = function (z:int array array) ->

 let b = z.(1).(0)

 and c = z.(0).(1) in

  ( b - c ) / 2 ;;




(** 
gauss_trace matrix
 *)


let gauss_trace = function (m: int array array) ->

 let mm = Matrix.matrix_int_cut 2 m in

  let mmm = Matrix.matrix_ioa_demakeup mm.(0) in

   let t = Matrix.int_demakeup ( Matrix.ioa_trace mmm.(0).(0) )

   and tt = Matrix.int_demakeup ( Matrix.ioa_trace mmm.(1).(0) ) in

    [| [| t ; - tt |] ; [| tt ; t |] |] ;;




(** 
matrix_gauss_real_part matrix
 *)


let matrix_gauss_real_part = function (m:int array array) ->

 let rrrr = Array.length m

 and cccc = Array.length m.(0) in

  let rr = rrrr / 2

  and cc = cccc / 2

  and rrr = rrrr - 1

  and ccc = cccc - 1 in

   let r = rr - 1

   and c = cc - 1 in

   let x = Matrix.sub_matrix m 0 r 0 c

   and xx = Matrix.sub_matrix m r rrr cc ccc in

    Matrix.matrix_int_scal_left_div 2 ( Matrix.matrix_int_plus x xx ) ;;




(** 
matrix_gauss_imag_part matrix
 *)


let matrix_gauss_imag_part = function (m:int array array) ->

 let rrrr = Array.length m

 and cccc = Array.length m.(0) in

  let rr = rrrr / 2

  and cc = cccc / 2

  and rrr = rrrr - 1

  and ccc = cccc - 1 in

   let r = rr - 1

   and c = cc - 1 in

   let y = Matrix.sub_matrix m rr rrr 0 c

   and yy = Matrix.sub_matrix m 0 r cc ccc in

    Matrix.matrix_int_scal_left_div 2 ( Matrix.matrix_int_minus y yy ) ;;




(** 
matrix_gauss_complexify matrix1 matrix2
 *)


let matrix_gauss_complexify = fun (x:int array array) (y:int array array) ->

 let m = [| [| Matrix.Int_matrix_cons x ; Matrix.Int_matrix_cons ( Matrix.matrix_int_opp y ) |] ;

             [| Matrix.Int_matrix_cons y ; Matrix.Int_matrix_cons x |] |] in

   Matrix.matrix_int_demakeup ( Matrix.matrix_ioa_crash ( Matrix.Ioa_matrix_cons m ) ) ;;




(** 
matrix_real_to_gauss matrix
 *)


let matrix_real_to_gauss = function (x:int array array) ->

 let z = Matrix.zeros_int x in

  matrix_gauss_complexify x z ;;




(** 
matrix_imag_to_gauss matrix
 *)


let matrix_imag_to_gauss = function (x:int array array) ->

 let z = Matrix.zeros_int x in

  matrix_gauss_complexify z x ;;




(** 
scal_gauss num_rows num_columns gauss_integer
 *)


let scal_gauss = fun (r:int) (c:int) (z:int array array) ->

 let x = Matrix.scal_int r c z.(0).(0)

 and y = Matrix.scal_int r c z.(1).(0) in

  matrix_gauss_complexify x y ;;




(** 
matrix_gauss_jordan order gauss_integer
 *)


let matrix_gauss_jordan = fun (n:int) (z:int array array) ->

 let x = scal_gauss n n z in

  for i = 0 to n - 2 do

   x.(i).( i + 1 ) <- 1 ;

   let nn = n + i in

    x.(nn).( nn + 1 ) <- 1 ;

  done ;

  x ;;




(** 
vector_gauss_scal_mult gauss_integer polynomial
 *)


let vector_gauss_scal_mult = fun (x:int array array) (v:int array array array) ->

 let l = Array.length v

 and zz = Array.make_matrix 2 2 0 in

  let vv = Array.make l zz in

   for i = 0 to l - 1 do

    vv.(i) <- Matrix.matrix_int_prod x v.(i)

   done ;

   vv ;;




(** 
matrix_gauss_scal_mult gauss_integer matrix
 *)


let matrix_gauss_scal_mult = fun (x:int array array) (m:int array array) ->

 let l = ( Array.length m ) / 2 in

  let xx = scal_gauss l l x in

   Matrix.matrix_int_prod xx m ;;




(** 
matrix_gauss_scal_left_div gauss_integer matrix
 *)


let matrix_gauss_scal_left_div = fun (x:int array array) (m:int array array) ->

 let l = ( Array.length m ) / 2 in

  let xx = Matrix.int_inv ( scal_gauss l l x ) in

   Matrix.matrix_int_prod xx m ;;




(** 
vector_gauss_norm_inf polynomial
 *)


let vector_gauss_norm_inf = function (p:int array array array) ->

 let v = Array.map Matrix.matrix_int_norm_inf p in

  Matrix.vector_int_norm_inf v ;;




(** 
vector_gauss_norm_1 polynomial
 *)


let vector_gauss_norm_1 = function (p:int array array array) ->

 let v = Array.map Matrix.matrix_int_norm_1 p in

  Matrix.vector_int_norm_1 v ;;




(** 
vector_gauss_square_norm_2 polynomial
 *)


let vector_gauss_square_norm_2 = function (p:int array array array) ->

 let v = Array.map gauss_square_module p in

  Matrix.vector_int_sum v ;;










(** 

Constantes


Constants

*)



(** 
 
 *)











(** 
complex_1
 *)


let complex_1 = Matrix.identity_float 2 2 ;;




(** 
complex_minus_1
 *)


let complex_minus_1 = Matrix.scal_float 2 2 (-1.) ;;




(** 
complex_0
 *)


let complex_0 = Matrix.null_float 2 2 ;;




(** 
complex_i
 *)


let complex_i = [| [| 0. ; -1. |] ; [| 1. ; 0. |] |] ;;






(** 
gauss_1
 *)


let gauss_1 = Matrix.identity_int 2 2 ;;




(** 
gauss_minus_1
 *)


let gauss_minus_1 = Matrix.scal_int 2 2 (-1) ;;




(** 
gauss_0
 *)


let gauss_0 = Matrix.null_int 2 2 ;;




(** 
gauss_i
 *)


let gauss_i = [| [| 0 ; -1 |] ; [| 1 ; 0 |] |] ;;






(** 
poly_real_x
 *)


let poly_real_x = [| 0. ; 1. |] ;;




(** 
poly_real_x_power integer
 *)


let poly_real_x_power = function (n:int) ->

 match n with

 | 0 -> [| 1. |]

 | 1 -> poly_real_x

 | _ -> let w = Array.make ( n + 1 ) 0. in

  w.(n) <- 1. ;

  w ;;




(** 
poly_real_x_a a
 *)


let poly_real_x_a = function (a:float) ->

 [| -. a ; 1. |] ;;






(** 
poly_int_x
 *)


let poly_int_x = [| 0 ; 1 |] ;;




(** 
poly_int_x_power integer
 *)


let poly_int_x_power = function (n:int) ->

 match n with

 | 0 -> [| 1 |]

 | 1 -> poly_int_x

 | _ -> let w = Array.make ( n + 1 ) 0 in

  w.(n) <- 1 ;

  w ;;




(** 
poly_int_x_a a
 *)


let poly_int_x_a = function (a:int) -> [| - a ; 1 |] ;;






(** 
poly_complex_x
 *)


let poly_complex_x = [| complex_0 ; complex_1 |] ;;




(** 
poly_complex_x_power integer
 *)


let poly_complex_x_power = function (n:int) ->

 match n with

 | 0 -> [| complex_1 |]

 | 1 -> poly_complex_x

 | _ -> let w = Array.make ( n + 1 ) complex_0 in

  w.(n) <- complex_1 ;

  w ;;




(** 
poly_complex_x_a a
 *)


let poly_complex_x_a = function (a:float array array) -> [| Matrix.matrix_float_opp a ; complex_1 |] ;;






(** 
poly_gauss_x
 *)


let poly_gauss_x = [| gauss_0 ; gauss_1 |] ;;




(** 
poly_gauss_x_power integer
 *)


let poly_gauss_x_power = function (n:int) -> match n with

 | 0 -> [| gauss_1 |]

 | 1 -> poly_gauss_x

 | _ -> let w = Array.make ( n + 1 ) gauss_0 in

  w.(n) <- gauss_1 ;

  w ;;




(** 
poly_gauss_x_a a
 *)


let poly_gauss_x_a = function (a:int array array) -> [| Matrix.matrix_int_opp a ; gauss_1 |] ;;






(** 
poly_sci_x
 *)


let poly_sci_x = [| Sci.sci_0 ; Sci.sci_1 |] ;;




(** 
poly_sci_x_power integer
 *)


let poly_sci_x_power = function (n:int) -> match n with

 | 0 -> [| Sci.sci_1 |]

 | 1 -> poly_sci_x

 | _ -> let w = Array.make ( n + 1 ) Sci.sci_0 in

  w.(n) <- Sci.sci_1 ;

  w ;;




(** 
poly_sci_x_a a
 *)


let poly_sci_x_a = function (a:Num.num array) -> [| Sci.opp a ; Sci.sci_1 |] ;;










(** 
§ 
 *)



(** 

Opérations élémentaires


Elementary operations

*)



(** 
 
 *)











(** 

Opérations polymorphes sur les polynômes


Polymorphic operations on polynomials

*)



(** 
 
 *)











(** 
extract_even_part polynomial
 *)


let extract_even_part = function p ->

 let r = Array.length p in

  if r = 0 then [| |]

  else

   begin

    let rr = ( r + 1 ) / 2 in

     let q = Array.make rr p.(0) in

      for i = 0 to pred rr do

       q.(i) <- p.( 2 * i )

      done ;

      q ;

   end ;;






(** 
extract_odd_part polynomial
 *)


let extract_odd_part = function p ->

 let r = Array.length p in

  if r = 0 then [| |]

  else

   begin

    let rr = ( r / 2 ) in

     let q = Array.make rr p.(0) in

      for i = 0 to pred rr do

       q.(i) <- p.( 2 * i + 1 )

      done ;

      q ;

   end ;;










(** 

Opérations polymorphes sur les matrices


Polymorphic operations on matrices

*)



(** 
 
 *)











(** 
matrix_complex_extract_coefficient row column matrix
 *)


let matrix_complex_extract_coefficient = fun (i:int) (j:int) m ->

 let n = ( Array.length m ) / 2 in

  let ii = n + i

  and jj = n + j

  and first_row = m.(i) in

   let second_row = m.(ii) in

    [| [| first_row.(j) ; first_row.(jj) |] ; [| second_row.(j) ; second_row.(jj) |] |] ;;






(** 
matrix_complex_extract_row_to_poly row_number matrix
 This function may apply to complex coefficients
(float array array) or Gauss integer coefficients (int array array).



Cette fonction peut être appliquée aux complexes (float array array) ou aux entiers de Gauss (int array array). *)


let matrix_complex_extract_row_to_poly = fun (i:int) m ->

 let r = ( Array.length m ) / 2

 and c = ( Array.length m.(0) ) / 2 in

  let ii = r + i

  and first_row = m.(i)

  and x = Array.make c ( Array.make_matrix 2 2 m.(0).(0) ) in

   let second_row = m.(ii) in

    for j = 0 to c - 1 do

     let jj = c + j in

      x.(j) <- [| [| first_row.(j) ; first_row.(jj) |] ; [| second_row.(j) ; second_row.(jj) |] |] ;

    done ;

    x ;;




(** 
matrix_complex_extract_row_to_vector row_number matrix
 *)


let matrix_complex_extract_row_to_vector = fun (i:int) m ->

 let r = ( Array.length m ) / 2

 and cc = Array.length m.(0) in

  let ii = r + i

  and c = cc / 2

  and x = Array.make cc m.(0).(0) in

   for j = 0 to c - 1 do

    let jj = c + j in

     x.(j) <- m.(i).(j) ;

     x.(jj) <- m.(ii).(j) ;

   done ;

   x ;;




(** 
matrix_complex_extract_row_to_matrix row_number matrix
 *)


let matrix_complex_extract_row_to_matrix = fun (i:int) m ->

 let cc = Array.length m.(0) in

  let r = ( Array.length m ) / 2

  and c = cc / 2 in

   let ii = r + i

   and first_row = m.(i)

   and x = Array.make_matrix cc 2 m.(0).(0) in

    let second_row = m.(ii) in

     for j = 0 to c - 1 do

      let jj = c + j in

       x.(j) <- [| first_row.(j) ; first_row.(jj) |] ;

       x.(jj) <- [| second_row.(j) ; second_row.(jj) |] ;

     done ;

     x ;;




(** 
matrix_complex_extract_row_to_matrix_trans row_number matrix
 *)


let matrix_complex_extract_row_to_matrix_trans = fun (i:int) m ->

 let first = m.(i)

 and second = m.( ( ( Array.length m ) / 2 ) + i ) in

  let cc = Array.length first in

   let x = Array.make cc m.(0).(0)

   and y = Array.make cc m.(0).(0)

   and c = cc / 2 in

    for j = 0 to c - 1 do

     let jj = c + j in

      x.(j) <- first.(j) ;

      x.(jj) <- second.(j) ;

      y.(j) <- first.(jj) ;

      y.(jj) <- second.(jj) ;

    done ;

    [| x ; y |] ;;






(** 
matrix_complex_extract_column_to_poly row_number matrix
 *)


let matrix_complex_extract_column_to_poly = fun (j:int) m ->

 let r = ( Array.length m ) / 2 in

  let jj = ( ( Array.length m.(0) ) / 2 ) + j

  and x = Array.make r ( Array.make_matrix 2 2 m.(0).(0) ) in

   for i = 0 to r - 1 do

    let first_row = m.(i)

    and ii = r + i in

     let second_row = m.(ii) in

      x.(i) <- [| [| first_row.(j) ; first_row.(jj) |] ; [| second_row.(j) ; second_row.(jj) |] |] ;

   done ;

   x ;;




(** 
matrix_complex_extract_column_to_vector column_number matrix
 *)


let matrix_complex_extract_column_to_vector = fun (j:int) m ->

 let rr = Array.length m in

  let r = rr / 2

  and x = Array.make rr m.(0).(0) in

   for i = 0 to r - 1 do

    let ii = r + i in

     x.(i) <- m.(i).(j) ;

     x.(ii) <- m.(ii).(j) ;

   done ;

   x ;;




(** 
matrix_complex_extract_column_to_matrix column_number matrix
 *)


let matrix_complex_extract_column_to_matrix = fun (j:int) m ->

 let rr = Array.length m in

  let r = rr / 2

  and x = Array.make_matrix rr 2 m.(0).(0) in

   let jj = ( ( Array.length m.(0) ) / 2 ) + j in

    for i = 0 to r - 1 do

     let first_row = m.(i)

     and ii = r + i in

      let second_row = m.(ii) in

       x.(i) <- [| first_row.(j) ; first_row.(jj) |] ;

       x.(ii) <- [| second_row.(j) ; second_row.(jj) |] ;

    done ;

    x ;;




(** 
matrix_complex_extract_column_to_matrix_trans column_number matrix
 *)


let matrix_complex_extract_column_to_matrix_trans = fun (j:int) m ->

 let rr = Array.length m in

  let r = rr / 2

  and x = Array.make rr m.(0).(0)

  and y = Array.make rr m.(0).(0) in

   let jj = ( Array.length m.(0) / 2 ) + j in

    for i = 0 to r - 1 do

     let first_row = m.(i)

     and ii = r + i in

      let second_row = m.(ii) in

       x.(i) <- first_row.(j) ;

       x.(ii) <- second_row.(j) ;

       y.(i) <- first_row.(jj) ;

       y.(ii) <- second_row.(jj) ;

    done ;

    [| x ; y |] ;;










(** 

Opérations élémentaires sur les matrices complexes


Elementary operations on complex matrices

*)



(** 
 
 *)











(** 
matrix_complex_extract_diag_to_poly matrix
 *)


let matrix_complex_extract_diag_to_poly = function (m:float array array) ->

 let n = ( min ( Array.length m ) ( Array.length m.(0) ) ) / 2 in

  let d = Array.make n complex_0 in

   for i = 0 to n - 1 do

    d.(i) <- matrix_complex_extract_coefficient i i m ;

   done ;

   d ;;




(** 
vector_complex_contraction polynomial
 *)


let vector_complex_contraction = fun (v:float array array array) ->

 let accu = ref complex_1 in

  for i = 0 to ( ( Array.length v ) / 2 ) - 1 do

   accu := Matrix.matrix_float_prod !accu v.(i) ;

  done ;

  !accu ;;






(** 
vector_complex_hermitian_product vector1 vector2
 The vectors must have the form of real matrices with two rows.



Les vecteurs doivent être sous forme de matrices réelles à deux lignes. *)


let vector_complex_hermitian_prod = fun (u:float array array) (v:float array array) ->

 Matrix.matrix_float_twisted_prod v u ;;




(** 
diag_complex polynomial
 *)


let diag_complex = function (x:float array array array) ->

 let n = Array.length x in

  let nnn = 2 * n

  and nn = n - 1 in

   let m = Array.make_matrix nnn nnn 0. in

    for i = 0 to nn do

     let ii = n + i

     and coeff = x.(i)

     and first_row = m.(i) in

      let second_row = m.(ii) in

       first_row.(i) <- coeff.(0).(0) ;

       first_row.(ii) <- coeff.(0).(1) ;

       second_row.(ii) <- coeff.(1).(1) ;

       second_row.(i) <- coeff.(1).(0) ;

    done ;

    m ;;




(** 
matrix_complex_non_diagonality norm matrix
 *)


let matrix_complex_non_diagonality = fun distance (m:float array array) ->

 let mm = Matrix.matrix_float_minus m ( diag_complex ( matrix_complex_extract_diag_to_poly m ) ) in

  distance mm ;;




(** 
matrix_complex_non_diagonal_part matrix
 *)


let matrix_complex_non_diagonal_part = function (m:float array array) ->

 Matrix.matrix_float_minus m ( diag_complex ( matrix_complex_extract_diag_to_poly m ) ) ;;




(** 
vector_complex_i_times vector
 *)


let vector_complex_i_times = function (v:float array) ->

 let rr = Array.length v in

  let r = rr / 2

  and w = Array.make rr v.(0) in

   for i = 0 to r - 1 do

    let ii = r + i in

    w.(i) <- -. v.(ii) ;

    w.(ii) <- v.(i) ;

   done ;

   w ;;




(** 
vector_complex_to_matrix vector
 *)


let vector_complex_to_matrix = function (v:float array) ->

 [| v ; vector_complex_i_times v |] ;;










(** 

Opérations élémentaires sur les matrices à coefficients entiers de Gauss


Elementary operations on matrices with Gauss integer coefficients

*)



(** 
 
 *)











(** 
matrix_gauss_extract_diag_to_poly matrix
 *)


let matrix_gauss_extract_diag_to_poly = function (m:int array array) ->

 let n = ( min ( Array.length m ) ( Array.length m.(0) ) ) / 2 in

  let d = Array.make n gauss_0 in

   for i = 0 to n - 1 do

    d.(i) <- matrix_complex_extract_coefficient i i m ;

   done ;

   d ;;




(** 
vector_gauss_contraction vector
 *)


let vector_gauss_contraction = fun (v:int array array array) ->

 let accu = ref gauss_1 in

  for i = 0 to ( ( Array.length v ) / 2 ) - 1 do

   accu := Matrix.matrix_int_prod !accu v.(i) ;

  done ;

  !accu ;;






(** 
vector_gauss_hermitian_product vector1 vector2
 The vectors must have the form of real matrices with two rows.



Les vecteurs doivent être sous forme de matrices réelles à deux lignes. *)


let vector_gauss_hermitian_prod = fun (u:int array array) (v:int array array) ->

 Matrix.matrix_int_twisted_prod v u ;;




(** 
diag_gauss polynomial
 *)


let diag_gauss = function (x:int array array array) ->

 let n = Array.length x in

  let nnn = 2 * n

  and nn = n - 1 in

   let m = Array.make_matrix nnn nnn 0 in

    for i = 0 to nn do

     let ii = n + i

     and coeff = x.(i)

     and first_row = m.(i) in

      let second_row = m.(ii) in

       first_row.(i) <- coeff.(0).(0) ;

       first_row.(ii) <- coeff.(0).(1) ;

       second_row.(ii) <- coeff.(1).(1) ;

       second_row.(i) <- coeff.(1).(0) ;

    done ;

    m ;;




(** 
matrix_gauss_non_diagonality norm matrix
 *)


let matrix_gauss_non_diagonality = fun distance (m:int array array) ->

 let mm = Matrix.matrix_int_minus m ( diag_gauss ( matrix_gauss_extract_diag_to_poly m ) ) in

  distance mm ;;




(** 
matrix_gauss_non_diagonal_part matrix
 *)


let matrix_gauss_non_diagonal_part = function (m:int array array) ->

 Matrix.matrix_int_minus m ( diag_gauss ( matrix_gauss_extract_diag_to_poly m ) ) ;;




(** 
vector_gauss_i_times vector
 *)


let vector_gauss_i_times = function (v:int array) ->

 let rr = Array.length v in

  let r = rr / 2

  and w = Array.make rr v.(0) in

   for i = 0 to r - 1 do

    let ii = r + i in

    w.(i) <- - v.(ii) ;

    w.(ii) <- v.(i) ;

   done ;

   w ;;




(** 
vector_gauss_to_matrix vector
 *)


let vector_gauss_to_matrix = function (v:int array) ->

 [| v ; vector_gauss_i_times v |] ;;










(** 

Opérations élémentaires sur les polynômes


Elementary operations on polynomials

*)



(** 
 
 *)











(** 

Polynômes à coefficients réels


Polynomials with real coefficients

*)



(** 
 
 *)











(** 
poly_real_deg polynomial
 *)
 

let poly_real_deg = function (p:float array) ->

 let r = ref ( ( Array.length p ) - 1 )

 and deg = ref neg_infinity in

  if !r >= 0 then 

   begin

    while !r >= 0 do

     begin 

      let coeff = p.(!r) in

       if coeff <> 0. then

        begin

         if abs_float coeff > max_float then

          ( deg := infinity ; r := -1 )

         else ( deg := float !r ; r := -1 )

        end

       else r := !r - 1 ;

     end

    done ;

   end ;

   !deg ;;




(** 
poly_real_val polynomial
 *)
 

let poly_real_val = function (p:float array) ->

 let rr = ( ( Array.length p ) - 1 )

 and r = ref 0

 and valuation = ref infinity in

  if !r <= rr then 

   begin

    while !r <= rr do

     begin 

      let coeff = p.(!r) in

       if coeff <> 0. then

        begin

         if abs_float coeff > max_float then

          ( valuation := neg_infinity ; r := max_int )

         else ( valuation := float !r ; r := max_int )

        end

       else r := !r + 1 ;

     end

    done ;

   end ;

   !valuation ;;




(** 
poly_real_cleanup polynomial
 *)


let poly_real_cleanup = function (p:float array) ->

 let d = poly_real_deg p in

  if d < 0. then [| 0. |]

  else

   begin

    let dd = int_of_float d in

     let q = Array.make ( dd + 1 ) 0. in

      for i = 0 to dd do

       q.(i) <- p.(i) ;

      done ;

      q ;

   end ;;




(** 
poly_real_normalize polynomial
 *)


let poly_real_normalize = function (p:float array) ->

 let d = poly_real_deg p in

  if d < 0. then [| 0. |]

  else

   begin

    let dd = int_of_float d in

     let q = Array.make ( dd + 1 ) 1.

     and coeff = 1. /. p.(dd) in

      for i = 0 to dd - 1 do

       q.(i) <- p.(i) *. coeff ;

      done ;

      q ;

   end ;;




(** 
poly_real_deriv polynomial
 *)
 

let poly_real_deriv = function (p:float array) ->

 let pp = ( Array.length p ) - 1 in

  let r = Array.make pp 0. in

   for i = 1 to pp do

    r.( i - 1 ) <- ( float i ) *. p.(i)

   done ;

   r ;;




(** 
poly_real_plus polynomial1 polynomial2
 *)
 

let poly_real_plus = fun (p:float array) (q:float array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let x = Array.concat [ p ; ( Array.make ( rr - pp ) 0. ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) 0. ) ] in

    Matrix.vector_float_plus x y ;;




(** 
poly_real_minus polynomial1 polynomial2
 *)
 

let poly_real_minus = fun (p:float array) (q:float array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let x = Array.concat [ p ; ( Array.make ( rr - pp ) 0. ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) 0. ) ] in

    Matrix.vector_float_minus x y ;;




(** 
poly_real_mult polynomial1 polynomial2
 *)
 

let poly_real_mult = fun (p:float array) (q:float array) ->

 let pp = Array.length p

 and qq = Array.length q

 and accu = ref 0. in

  let qqq = qq - 1 in

   let rr = pp + qqq in

    let x = Array.concat [ p ; ( Array.make qq 0. ) ]

    and y = Array.concat [ q ; ( Array.make pp 0. ) ]

    and r = Array.make rr 0. in

     for i = 0 to rr - 1 do

      for j = 0 to i do

       accu := !accu +. x.(j) *. y.( i - j ) ;

      done ;

      r.(i) <- !accu ;

      accu := 0. ;

     done ;

     r ;;




(** 
poly_real_mult_karatsuba threshold polynomial1 polynomial2
 *)


let rec poly_real_mult_karatsuba = fun (threshold:int) (p:float array) (q:float array) ->

 let l = Array.length p

 and ll = Array.length q in

  let l_l = max l ll in

   if l_l <= threshold then poly_real_mult p q

   else

    begin

     let half = ( l_l ) / 2

     and p_p = Array.append p ( Array.make ( l_l - l ) 0. )

     and q_q = Array.append q ( Array.make ( l_l - ll ) 0. ) in

      let pp = Array.sub p_p 0 half

      and ppp = Array.sub p_p half ( l_l - half )

      and qq = Array.sub q_q 0 half

      and qqq = Array.sub q_q half ( l_l - half ) in

       let debut = poly_real_mult_karatsuba threshold pp qq

       and fin = poly_real_mult_karatsuba threshold ppp qqq

       and psum = poly_real_plus pp ppp

       and qsum = poly_real_plus qq qqq in

        let mix = poly_real_mult_karatsuba threshold psum qsum in

         let inter = poly_real_minus mix debut in

          let milieu = poly_real_minus inter fin in

           let first = poly_real_plus debut ( Array.append ( Array.make ( half ) 0. ) milieu ) in

            let raw_prod = poly_real_plus first ( Array.append ( Array.make ( 2 * half ) 0. ) fin ) in

             poly_real_cleanup raw_prod

    end ;;




(** 
poly_real_pow mult_rule power polynomial
 *)
 

let rec poly_real_pow = fun mult_rule (n:int) (p:float array) ->

 match n with

  | 0 -> [| 1. |]

  | 1 -> p

  | 2 -> mult_rule p p

  | _ ->

   begin

    let nn = n / 2 in

     let pp = poly_real_pow mult_rule nn p in

      let prod = mult_rule pp pp in

       if n mod 2 = 0 then

        prod

       else

        mult_rule prod p

   end ;;




(** 
poly_real_finite_prod mult_rule polynomial_array
 *)
 

let rec poly_real_finite_prod = fun mult_rule (p:float array array) ->

 let n = ( Array.length p ) - 1

 and q = ref p.(0) in

  for i = 1 to n do

   q := mult_rule !q p.(i) ;

  done ;

  !q ;;




(** 
poly_real_from_roots mult_rule roots_array
 *)
 

let poly_real_from_roots = fun mult_rule (r:float array) ->

 let a = Array.map poly_real_x_a r in

  poly_real_finite_prod mult_rule a ;;




(** 
poly_real_horner_comp polynomial1 polynomial2
 *)
 

let poly_real_horner_comp = fun (p:float array) (q:float array) ->

 let pp = Array.length p in

  let res = ref [| p.( pp - 1 ) |] in 

   for i = pp - 2 downto 0 do

    res := poly_real_plus ( poly_real_mult !res q ) [| p.(i) |] ;

   done ;

   !res ;;




(** 
poly_real_ranged_horner_comp mult_rule index order polynomial1 polynomial2
 *)
 

let poly_real_ranged_horner_comp = fun mult_rule (i:int) (l:int) (p:float array) (q:float array) ->

 let res = ref [| p.( i + l - 1 ) |] in 

  for j = l - 2 downto 0 do

   res := poly_real_plus ( mult_rule !res q ) [| p.( i + j ) |] ;

  done ;

  !res ;;






(** 
poly_real_brent_kung_hart_novocin_comp mult_rule parameter polynomial1 polynomial2
 The length l must be greater than or equal to 3.
The algorithm comes from the document located at the following address.



http://hal-ens-lyon.archives-ouvertes.fr/docs/00/54/61/02/PDF/dmtcs_NOVOCIN2010.pdf



L'algorithme provient du document situé à l'adresse précédente.
La longueur l doit être supérieure ou égale à 3. *)
 

let poly_real_brent_kung_hart_novocin_comp = fun mult_rule (l:int) (p:float array) (q:float array) ->

 let n = ( Array.length p ) - 1

 and g = ref ( poly_real_pow mult_rule l q ) in

  let k = ref ( ( n + 1 ) / l + 1 ) in

   let pp = Array.append p ( Array.make ( !k * l - n ) 0. ) in

    k := ( 1 + ( Array.length pp ) ) / l ;

    let h = Array.make_matrix ( ( !k + l ) * 2 ) 1 0.

    and hh = Array.make_matrix ( ( !k + l ) * 2 ) 1 0. in 

     for j = 0 to !k - 1 do

      h.(j) <- poly_real_ranged_horner_comp mult_rule ( j * l ) l pp q ;

     done ;

     while !k > 1 do

      k := ( !k + 1 )/ 2 ;

      for j = 0 to !k do

       hh.(j) <- poly_real_plus h.( 2 * j ) ( mult_rule !g h.( 2 * j + 1 ) )

      done ;

      for j = 0 to !k - 1 do

       h.(j) <- Matrix.vector_float_copy hh.(j) ;

      done ;

      if !k > 1 then g := mult_rule !g !g ;

     done ;

     h.(0) ;;




(** 
poly_real_evaluate comp_rule polynomial real
 *)


let poly_real_evaluate = fun comp_rule (p:float array) (x0:float) ->

 ( comp_rule p [| x0 |] ).(0) ;;






(** 
real_sylvester_matrix polynomial1 polynomial2
 *)


let real_sylvester_matrix = fun (p:float array) (q:float array) ->

 let dp = int_of_float ( poly_real_deg p )

 and dq = int_of_float ( poly_real_deg q ) in

  let dd = dp + dq in

   let m = Array.make_matrix dd dd 0. in

    for i = 0 to pred dq do

     let row = m.(i)

     and ii = i + dp in

      for j = i to ii do

       row.(j) <- p.( ii - j ) ;

      done ;

    done ;

    for i = 0 to pred dp do

     let ii = i + dq in

      let row = m.(ii) in

       for j = i to ii do

        row.(j) <- q.( ii - j ) ;

       done ;

    done ;

    m ;;




(** 
real_resultant det_methode polynomial1 polynomial2
 *)


let real_resultant = fun det_methode (p:float array) (q:float array) ->

 let m = real_sylvester_matrix p q in

  det_methode m ;;




(** 
real_discriminant det_methode polynomial
 *)


let real_discriminant = fun det_methode (p:float array) ->

 real_resultant det_methode p ( poly_real_deriv p ) ;;










(** 

Polynômes à coefficients entiers


Polynomials with integer coefficients

*)



(** 
 
 *)











(** 
poly_int_deg polynomial
 *)
 

let poly_int_deg = function (p:int array) ->

 let r = ref ( ( Array.length p ) - 1 )

 and deg = ref neg_infinity in

  if !r >= 0 then 

   begin

    while !r >= 0 do

     begin 

      if p.(!r) <> 0 then

       ( deg := float !r ; r := -1 )

      else r := !r - 1 ;

     end

    done ;

   end ;

   !deg ;;




(** 
poly_int_val polynomial
 *)
 

let poly_int_val = function (p:int array) ->

 let rr = ( ( Array.length p ) - 1 )

 and r = ref 0

 and valuation = ref infinity in

  if !r <= rr then 

   begin

    while !r <= rr do

     begin 

      if p.(!r) <> 0 then

       ( valuation := float !r ; r := max_int )

      else r := !r + 1 ;

     end

    done ;

   end ;

   !valuation ;;




(** 
poly_int_cleanup polynomial
 *)


let poly_int_cleanup = function (p:int array) ->

 let d = poly_int_deg p in

  if d < 0. then [| 0 |]

  else

   begin

    let dd = int_of_float d in

     let q = Array.make ( dd + 1 ) 0 in

      for i = 0 to dd do

       q.(i) <- p.(i) ;

      done ;

      q ;

   end ;;




(** 
poly_int_deriv polynomial
 *)
 

let poly_int_deriv = function (p:int array) ->

 let pp = ( Array.length p ) - 1 in

  let r = Array.make pp 0 in

   for i = 1 to pp do

    r.( i - 1 ) <- i * p.(i)

   done ;

   r ;;




(** 
poly_int_plus polynomial1 polynomial2
 *)
 

let poly_int_plus = fun (p:int array) (q:int array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let x = Array.concat [ p ; ( Array.make ( rr - pp ) 0 ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) 0 ) ] in

    Matrix.vector_int_plus x y ;;




(** 
poly_int_minus polynomial1 polynomial2
 *)
 

let poly_int_minus = fun (p:int array) (q:int array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let x = Array.concat [ p ; ( Array.make ( rr - pp ) 0 ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) 0 ) ] in

    Matrix.vector_int_minus x y ;;




(** 
poly_int_mult polynomial1 polynomial2
 *)
 

let poly_int_mult = fun (p:int array) (q:int array) ->

 let pp = Array.length p

 and qq = Array.length q

 and accu = ref 0 in

  let qqq = qq - 1 in

   let rr = pp + qqq in

    let x = Array.concat [ p ; ( Array.make qq 0 ) ]

    and y = Array.concat [ q ; ( Array.make pp 0 ) ]

    and r = Array.make rr 0 in

     for i = 0 to rr - 1 do

      for j = 0 to i do

       accu := !accu + x.(j) * y.( i - j ) ;

      done ;

      r.(i) <- !accu ;

      accu := 0 ;

     done ;

     r ;;




(** 
poly_int_mult_karatsuba threshold polynomial1 polynomial2
 *)


let rec poly_int_mult_karatsuba = fun (threshold:int) (p:int array) (q:int array) ->

 let l = Array.length p

 and ll = Array.length q in

  let l_l = max l ll in

   if l_l <= threshold then poly_int_mult p q

   else

    begin

     let half = ( l_l ) / 2

     and p_p = Array.append p ( Array.make ( l_l - l ) 0 )

     and q_q = Array.append q ( Array.make ( l_l - ll ) 0 ) in

      let pp = Array.sub p_p 0 half

      and ppp = Array.sub p_p half ( l_l - half )

      and qq = Array.sub q_q 0 half

      and qqq = Array.sub q_q half ( l_l - half ) in

       let debut = poly_int_mult_karatsuba threshold pp qq

       and fin = poly_int_mult_karatsuba threshold ppp qqq

       and psum = poly_int_plus pp ppp

       and qsum = poly_int_plus qq qqq in

        let mix = poly_int_mult_karatsuba threshold psum qsum in

         let inter = poly_int_minus mix debut in

          let milieu = poly_int_minus inter fin in

           let first = poly_int_plus debut ( Array.append ( Array.make ( half ) 0 ) milieu ) in

            let raw_prod = poly_int_plus first ( Array.append ( Array.make ( 2 * half ) 0 ) fin ) in

             poly_int_cleanup raw_prod

    end ;;




(** 
poly_int_pow mult_rule power polynomial
 *)
 

let rec poly_int_pow = fun mult_rule (n:int) (p:int array) ->

 match n with

  | 0 -> [| 1 |]

  | 1 -> p

  | 2 -> mult_rule p p

  | _ ->

   begin

    let nn = n / 2 in

     let pp = poly_int_pow mult_rule nn p in

      let prod = mult_rule pp pp in

       if n mod 2 = 0 then

        prod

       else

        mult_rule prod p

   end ;;




(** 
poly_int_finite_prod mult_rule polynomial_array
 *)
 

let rec poly_int_finite_prod = fun mult_rule (p:int array array) ->

 let n = ( Array.length p ) - 1

 and q = ref p.(0) in

  for i = 1 to n do

   q := mult_rule !q p.(i) ;

  done ;

  !q ;;




(** 
poly_int_from_roots mult_rule roots_array
 *)
 

let poly_int_from_roots = fun mult_rule (r:int array) ->

 let a = Array.map poly_int_x_a r in

  poly_int_finite_prod mult_rule a ;;




(** 
poly_int_horner_comp polynomial1 polynomial2
 *)
 

let poly_int_horner_comp = fun (p:int array) (q:int array) ->

 let pp = Array.length p in

  let res = ref [| p.( pp - 1 ) |] in 

   for i = pp - 2 downto 0 do

    res := poly_int_plus ( poly_int_mult !res q ) [| p.(i) |] ;

   done ;

   !res ;;




(** 
poly_int_ranged_horner_comp mult_rule index order polynomial1 polynomial2
 *)
 

let poly_int_ranged_horner_comp = fun mult_rule (i:int) (l:int) (p:int array) (q:int array) ->

 let res = ref [| p.( i + l - 1 ) |] in 

  for j = l - 2 downto 0 do

   res := poly_int_plus ( mult_rule !res q ) [| p.( i + j ) |] ;

  done ;

  !res ;;






(** 
poly_int_brent_kung_hart_novocin_comp mult_rule parameter polynomial1 polynomial2
 The length l must be greater than or equal to 3.
The algorithm comes from the document located at the following address.



http://hal-ens-lyon.archives-ouvertes.fr/docs/00/54/61/02/PDF/dmtcs_NOVOCIN2010.pdf



L'algorithme provient du document situé à l'adresse précédente.
La longueur l doit être supérieure ou égale à 3. *)
 

let poly_int_brent_kung_hart_novocin_comp = fun mult_rule (l:int) (p:int array) (q:int array) ->

 let n = ( Array.length p ) - 1

 and g = ref ( poly_int_pow mult_rule l q ) in

  let k = ref ( ( n + 1 ) / l + 1 ) in

   let pp = Array.append p ( Array.make ( !k * l - n ) 0 ) in

    k := ( 1 + ( Array.length pp ) ) / l ;

    let h = Array.make_matrix ( ( !k + l ) * 2 ) 1 0

    and hh = Array.make_matrix ( ( !k + l ) * 2 ) 1 0 in 

     for j = 0 to !k - 1 do

      h.(j) <- poly_int_ranged_horner_comp mult_rule ( j * l ) l pp q ;

     done ;

     while !k > 1 do

      k := ( !k + 1 )/ 2 ;

      for j = 0 to !k do

       hh.(j) <- poly_int_plus h.( 2 * j ) ( mult_rule !g h.( 2 * j + 1 ) )

      done ;

      for j = 0 to !k - 1 do

       h.(j) <- Matrix.vector_int_copy hh.(j) ;

      done ;

      if !k > 1 then g := mult_rule !g !g ;

     done ;

     h.(0) ;;




(** 
poly_int_evaluate comp_rule polynomial integer
 *)


let poly_int_evaluate = fun comp_rule (p:int array) (x0:int) ->

 ( comp_rule p [| x0 |] ).(0) ;;






(** 
int_sylvester_matrix polynomial1 polynomial2
 *)


let int_sylvester_matrix = fun (p:int array) (q:int array) ->

 let dp = int_of_float ( poly_int_deg p )

 and dq = int_of_float ( poly_int_deg q ) in

  let dd = dp + dq in

   let m = Array.make_matrix dd dd 0 in

    for i = 0 to pred dq do

     let row = m.(i)

     and ii = i + dp in

      for j = i to ii do

       row.(j) <- p.( ii - j ) ;

      done ;

    done ;

    for i = 0 to pred dp do

     let ii = i + dq in

      let row = m.(ii) in

       for j = i to ii do

        row.(j) <- q.( ii - j ) ;

       done ;

    done ;

    m ;;




(** 
int_resultant det_methode polynomial1 polynomial2
 *)


let int_resultant = fun det_methode (p:int array) (q:int array) ->

 let m = int_sylvester_matrix p q in

  det_methode m ;;




(** 
int_discriminant det_methode polynomial
 *)


let int_discriminant = fun det_methode (p:int array) ->

 int_resultant det_methode p ( poly_int_deriv p ) ;;










(** 

Polynômes à coefficients complexes


Polynomials with complex coefficients

*)



(** 
 
 *)











(** 
poly_complex_deg polynomial
 *)
 

let poly_complex_deg = function (p:float array array array) ->

 let r = ref ( ( Array.length p ) - 1 )

 and deg = ref neg_infinity in

  if !r >= 0 then 

   begin

    while !r >= 0 do

     begin 

      let coeff = Matrix.matrix_float_norm_inf p.(!r) in

       if coeff <> 0. then

        if coeff > max_float then

         ( deg := infinity ; r := -1 )

         else ( deg := float !r ; r := -1 )

       else r := !r - 1 ;

     end

    done ;

   end ;

   !deg ;;




(** 
poly_complex_val polynomial
 *)
 

let poly_complex_val = function (p:float array array array) ->

 let rr = ( ( Array.length p ) - 1 )

 and r = ref 0

 and valuation = ref infinity in

  if !r <= rr then 

   begin

    while !r <= rr do

     begin

      let coeff = Matrix.matrix_float_norm_inf p.(!r) in

       if coeff <> 0. then

        begin

         if coeff > max_float then

          ( valuation := neg_infinity ; r := max_int )

         else ( valuation := float !r ; r := max_int )

        end

       else r := !r + 1 ;

     end

    done ;

   end ;

   !valuation ;;




(** 
poly_complex_cleanup polynomial
 *)


let poly_complex_cleanup = function (p:float array array array) ->

 let d = poly_complex_deg p in

  if d < 0. then [| complex_0 |]

  else

   begin

    let dd = int_of_float d in

     let q = Array.make ( dd + 1 ) complex_0 in

      for i = 0 to dd do

       q.(i) <- p.(i) ;

      done ;

      q ;

   end ;;




(** 
poly_complex_normalize polynomial
 *)


let poly_complex_normalize = function (p:float array array array) ->

 let d = poly_complex_deg p in

  if d < 0. then [| complex_0 |]

  else

   begin

    let dd = int_of_float d in

     let q = Array.make ( dd + 1 ) complex_1

     and coeff = complex_inv p.(dd) in

      for i = 0 to dd - 1 do

       q.(i) <- Matrix.matrix_float_prod p.(i) coeff ;

      done ;

      q ;

   end ;;




(** 
poly_complex_copy polynomial
 *)


let poly_complex_copy = function (p:float array array array) ->

 let r = Array.length p in

  let q = Array.make r complex_0 in

   for i = 0 to r - 1 do

    q.(i) <- Matrix.matrix_float_copy p.(i)

   done ;

   q ;;




(** 
complex_poly_to_complex_vector polynomial
 *)


let complex_poly_to_complex_vector = function (p:float array array array) ->

 let l = Array.length p in

  let v = Array.make ( 2 * l ) 0. in

   for i = 0 to l - 1 do

    v.(i) <- 0.5 *. ( p.(i).(0).(0) +. p.(i).(1).(1) ) ;

    v.( l + i ) <- 0.5 *. ( p.(i).(1).(0) -. p.(i).(0).(1) ) ;

   done ;

   v ;;




(** 
complex_poly_to_complex_double_vector polynomial
 *)


let complex_poly_to_complex_double_vector = function (p:float array array array) ->

 let l = Array.length p in

  let v = Array.make ( 2 * l ) 0.

  and vv = Array.make ( 2 * l ) 0. in

   for i = 0 to l - 1 do

    v.(i) <- p.(i).(0).(0) ;

    v.( l + i ) <- p.(i).(1).(0) ;

    vv.(i) <- p.(i).(0).(1) ;

    vv.( l + i ) <- p.(i).(1).(1) ;

   done ;

   [| v ; vv |] ;;




(** 
complex_vector_to_complex_poly vector
 *)


let complex_vector_to_complex_poly = function (v:float array) ->

 let l = ( Array.length v ) / 2 in

  let p = Array.make l complex_0 in

   for i = 0 to l - 1 do

    p.(i) <- [| [| v.(i) ; -. v.( l + i ) |] ; [| v.( l + i ) ; v.(i) |] |] ;

   done ;

   p ;;




(** 
poly_complex_deriv polynomial
 *)
 

let poly_complex_deriv = function (p:float array array array) ->

 let pp = ( Array.length p ) - 1 in

  let r = Array.make pp ( Array.make_matrix 2 2 0. ) in

   for i = 1 to pp do

    r.( i - 1 ) <- Matrix.matrix_float_scal_mult ( float i ) p.(i)

   done ;

   r ;;




(** 
poly_complex_plus polynomial1 polynomial2
 *)
 

let poly_complex_plus = fun (p:float array array array) (q:float array array array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let r = Array.make rr ( Array.make_matrix 2 2 0. )

   and x = Array.concat [ p ; ( Array.make ( rr - pp ) ( Array.make_matrix 2 2 0. ) ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) ( Array.make_matrix 2 2 0. ) ) ] in

    for i = 0 to rr - 1 do

     r.(i) <- Matrix.matrix_float_plus x.(i) y.(i)

    done ; 

    r ;;




(** 
poly_complex_minus polynomial1 polynomial2
 *)
 

let poly_complex_minus = fun (p:float array array array) (q:float array array array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let r = Array.make rr ( Array.make_matrix 2 2 0. )

   and x = Array.concat [ p ; ( Array.make ( rr - pp ) ( Array.make_matrix 2 2 0. ) ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) ( Array.make_matrix 2 2 0. ) ) ] in

    for i = 0 to rr - 1 do

     r.(i) <- Matrix.matrix_float_minus x.(i) y.(i)

    done ; 

    r ;;




(** 
poly_complex_mult polynomial1 polynomial2
 *)
 

let poly_complex_mult = fun (p:float array array array) (q:float array array array) ->

 let pp = Array.length p

 and qq = Array.length q

 and accu = ref ( Array.make_matrix 2 2 0. ) in

  let qqq = qq - 1 in

   let rr = pp + qqq in

    let x = Array.concat [ p ; ( Array.make qq ( Array.make_matrix 2 2 0. ) ) ]

    and y = Array.concat [ q ; ( Array.make pp ( Array.make_matrix 2 2 0. ) ) ]

    and r = Array.make rr ( Array.make_matrix 2 2 0. ) in

     for i = 0 to rr - 1 do

      for j = 0 to i do

       accu := Matrix.matrix_float_plus !accu ( Matrix.matrix_float_prod x.(j) y.( i - j ) ) ;

      done ;

      r.(i) <- !accu ;

      accu := Array.make_matrix 2 2 0. ;

     done ;

     r ;;




(** 
poly_complex_mult_karatsuba threshold polynomial1 polynomial2
 *)


let rec poly_complex_mult_karatsuba = fun (threshold:int) (p:float array array array) (q:float array array array) ->

 let l = Array.length p

 and ll = Array.length q in

  let l_l = max l ll in

   if l_l <= threshold then poly_complex_mult p q

   else

    begin

     let half = ( l_l ) / 2

     and p_p = Array.append p ( Array.make ( l_l - l ) complex_0 )

     and q_q = Array.append q ( Array.make ( l_l - ll ) complex_0 ) in

      let pp = Array.sub p_p 0 half

      and ppp = Array.sub p_p half ( l_l - half )

      and qq = Array.sub q_q 0 half

      and qqq = Array.sub q_q half ( l_l - half ) in

       let debut = poly_complex_mult_karatsuba threshold pp qq

       and fin = poly_complex_mult_karatsuba threshold ppp qqq

       and psum = poly_complex_plus pp ppp

       and qsum = poly_complex_plus qq qqq in

        let mix = poly_complex_mult_karatsuba threshold psum qsum in

         let inter = poly_complex_minus mix debut in

          let milieu = poly_complex_minus inter fin in

           let first = poly_complex_plus debut ( Array.append ( Array.make ( half ) complex_0 ) milieu ) in

            let raw_prod = poly_complex_plus first ( Array.append ( Array.make ( 2 * half ) complex_0 ) fin ) in

             poly_complex_cleanup raw_prod

    end ;;




(** 
poly_complex_pow mult_rule power polynomial
 *)
 

let rec poly_complex_pow = fun mult_rule (n:int) (p:float array array array) ->

 match n with

  | 0 -> [| complex_1 |]

  | 1 -> p

  | 2 -> mult_rule p p

  | _ ->

   begin

    let nn = n / 2 in

     let pp = poly_complex_pow mult_rule nn p in

      let prod = mult_rule pp pp in

       if n mod 2 = 0 then

        prod

       else

        mult_rule prod p

   end ;;




(** 
poly_complex_finite_prod mult_rule polynomial_array
 *)
 

let rec poly_complex_finite_prod = fun mult_rule (p:float array array array array) ->

 let n = ( Array.length p ) - 1

 and q = ref p.(0) in

  for i = 1 to n do

   q := mult_rule !q p.(i) ;

  done ;

  !q ;;




(** 
poly_complex_from_roots mult_rule roots_array
 *)
 

let poly_complex_from_roots = fun mult_rule (r:float array array array) ->

 let a = Array.map poly_complex_x_a r in

  poly_complex_finite_prod mult_rule a ;;




(** 
poly_complex_horner_comp polynomial1 polynomial2
 *)
 

let poly_complex_horner_comp = fun (p:float array array array ) (q:float array array array) ->

 let pp = Array.length p in

  let res = ref [| p.( pp - 1 ) |] in 

   for i = pp - 2 downto 0 do

    res := poly_complex_plus ( poly_complex_mult !res q ) [| p.(i) |] ;

   done ;

   !res ;;




(** 
poly_complex_ranged_horner_comp mult_rule index order polynomial1 polynomial2
 *)
 

let poly_complex_ranged_horner_comp = fun mult_rule (i:int) (l:int) (p:float array array array) (q:float array array array) ->

 let res = ref [| p.( i + l - 1 ) |] in 

  for j = l - 2 downto 0 do

   res := poly_complex_plus ( mult_rule !res q ) [| p.( i + j ) |] ;

  done ;

  !res ;;






(** 
poly_complex_brent_kung_hart_novocin_comp mult_rule parameter polynomial1 polynomial2
 The length l must be greater than or equal to 3.
The algorithm comes from the document located at the following address.



http://hal-ens-lyon.archives-ouvertes.fr/docs/00/54/61/02/PDF/dmtcs_NOVOCIN2010.pdf



L'algorithme provient du document situé à l'adresse précédente.
La longueur l doit être supérieure ou égale à 3. *)
 

let poly_complex_brent_kung_hart_novocin_comp = fun mult_rule (l:int) (p:float array array array) (q:float array array array) ->

 let n = ( Array.length p ) - 1

 and g = ref ( poly_complex_pow mult_rule l q ) in

  let k = ref ( ( n + 1 ) / l + 1 ) in

   let pp = Array.append p ( Array.make ( !k * l - n ) complex_0 ) in

    k := ( 1 + ( Array.length pp ) ) / l ;

    let h = Array.make_matrix ( ( !k + l ) * 2 ) 1 complex_0

    and hh = Array.make_matrix ( ( !k + l ) * 2 ) 1 complex_0 in 

     for j = 0 to !k - 1 do

      h.(j) <- poly_complex_ranged_horner_comp mult_rule ( j * l ) l pp q ;

     done ;

     while !k > 1 do

      k := ( !k + 1 )/ 2 ;

      for j = 0 to !k do

       hh.(j) <- poly_complex_plus h.( 2 * j ) ( mult_rule !g h.( 2 * j + 1 ) )

      done ;

      for j = 0 to !k - 1 do

       h.(j) <- poly_complex_copy hh.(j) ;

      done ;

      if !k > 1 then g := mult_rule !g !g ;

     done ;

     h.(0) ;;




(** 
poly_complex_evaluate comp_rule polynomial complex
 *)


let poly_complex_evaluate = fun comp_rule (p:float array array array) (x0:float array array) ->

 ( comp_rule p [| x0 |] ).(0) ;;






(** 
complex_sylvester_matrix polynomial1 polynomial2
 *)


let complex_sylvester_matrix = fun (p:float array array array) (q:float array array array) ->

 let dp = int_of_float ( poly_complex_deg p )

 and dq = int_of_float ( poly_complex_deg q ) in

  let dd = dp + dq in

   let ddd = 2 * dd in

    let m = Array.make_matrix ddd ddd 0. in

     for i = 0 to pred dq do

      let first_row = m.(i)

      and second_row = m.( dd + i )

      and ii = i + dp in

       for j = i to ii do

        let jj = dd + j in

         first_row.(j) <- complex_real_part p.( ii - j ) ;

         first_row.(jj) <- -. complex_imaginary_part p.( ii - j ) ;

         second_row.(j) <- complex_imaginary_part p.( ii - j ) ;

         second_row.(jj) <- complex_real_part p.( ii - j ) ;

       done ;

     done ;

     for i = 0 to pred dp do

      let ii = i + dq in

       let first_row = m.(ii)

       and second_row = m.( dd + ii ) in

        for j = i to ii do

         let jj = dd + j in

          first_row.(j) <- complex_real_part q.( ii - j ) ;

          first_row.(jj) <- -. complex_imaginary_part q.( ii - j ) ;

          second_row.(j) <- complex_imaginary_part q.( ii - j ) ;

          second_row.(jj) <- complex_real_part q.( ii - j ) ;

        done ;

     done ;

     m ;;




(** 
complex_resultant det_methode polynomial1 polynomial2
 *)


let complex_resultant = fun det_methode (p:float array array array) (q:float array array array) ->

 let m = complex_sylvester_matrix p q in

  det_methode m ;;




(** 
complex_discriminant det_methode polynomial
 *)


let complex_discriminant = fun det_methode (p:float array array array) ->

 complex_resultant det_methode p ( poly_complex_deriv p ) ;;










(** 

Polynômes à coefficients entiers de Gauss


Polynomials with Gauss integer coefficients

*)



(** 
 
 *)











(** 
poly_gauss_deg polynomial
 *)
 

let poly_gauss_deg = function (p:int array array array) ->

 let r = ref ( ( Array.length p ) - 1 )

 and deg = ref neg_infinity in

  if !r >= 0 then 

   begin

    while !r >= 0 do

     begin 

      let coeff = Matrix.matrix_int_norm_inf p.(!r) in

       if coeff <> 0 then

        ( deg := float !r ; r := -1 )

       else r := !r - 1 ;

     end

    done ;

   end ;

   !deg ;;




(** 
poly_gauss_val polynomial
 *)
 

let poly_gauss_val = function (p:int array array array) ->

 let rr = ( ( Array.length p ) - 1 )

 and r = ref 0

 and valuation = ref infinity in

  if !r <= rr then 

   begin

    while !r <= rr do

     begin

      let coeff = Matrix.matrix_int_norm_inf p.(!r) in

       if coeff <> 0 then

        ( valuation := float !r ; r := max_int )

       else r := !r + 1 ;

     end

    done ;

   end ;

   !valuation ;;




(** 
poly_gauss_cleanup polynomial
 *)


let poly_gauss_cleanup = function (p:int array array array) ->

 let d = poly_gauss_deg p in

  if d < 0. then [| gauss_0 |]

  else

   begin

    let dd = int_of_float d in

     let q = Array.make ( dd + 1 ) gauss_0 in

      for i = 0 to dd do

       q.(i) <- p.(i) ;

      done ;

      q ;

   end ;;




(** 
poly_gauss_copy polynomial
 *)


let poly_gauss_copy = function (p:int array array array) ->

 let r = Array.length p in

  let q = Array.make r gauss_0 in

   for i = 0 to r - 1 do

    q.(i) <- Matrix.matrix_int_copy p.(i)

   done ;

   q ;;




(** 
gauss_poly_to_gauss_vector polynomial
 *)


let gauss_poly_to_gauss_vector = function (p:int array array array) ->

 let l = Array.length p in

  let v = Array.make ( 2 * l ) 0 in

   for i = 0 to l - 1 do

    v.(i) <- ( p.(i).(0).(0) + p.(i).(1).(1) ) / 2 ;

    v.( l + i ) <- ( p.(i).(1).(0) - p.(i).(0).(1) ) / 2 ;

   done ;

   v ;;




(** 
gauss_poly_to_gauss_double_vector polynomial
 *)


let gauss_poly_to_gauss_double_vector = function (p:int array array array) ->

 let l = Array.length p in

  let v = Array.make ( 2 * l ) 0

  and vv = Array.make ( 2 * l ) 0 in

   for i = 0 to l - 1 do

    v.(i) <- p.(i).(0).(0) ;

    v.( l + i ) <- p.(i).(1).(0) ;

    vv.(i) <- p.(i).(0).(1) ;

    vv.( l + i ) <- p.(i).(1).(1) ;

   done ;

   [| v ; vv |] ;;




(** 
gauss_vector_to_gauss_poly vector
 *)


let gauss_vector_to_gauss_poly = function (v:int array) ->

 let l = ( Array.length v ) / 2 in

  let p = Array.make l gauss_0 in

   for i = 0 to l - 1 do

    p.(i) <- [| [| v.(i) ; - v.( l + i ) |] ; [| v.( l + i ) ; v.(i) |] |] ;

   done ;

   p ;;




(** 
poly_gauss_deriv polynomial
 *)
 

let poly_gauss_deriv = function (p:int array array array) ->

 let pp = ( Array.length p ) - 1 in

  let r = Array.make pp ( Array.make_matrix 2 2 0 ) in

   for i = 1 to pp do

    r.( i - 1 ) <- Matrix.matrix_int_scal_mult i p.(i)

   done ;

   r ;;




(** 
poly_gauss_plus polynomial1 polynomial2
 *)
 

let poly_gauss_plus = fun (p:int array array array) (q:int array array array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let r = Array.make rr ( Array.make_matrix 2 2 0 )

   and x = Array.concat [ p ; ( Array.make ( rr - pp ) ( Array.make_matrix 2 2 0 ) ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) ( Array.make_matrix 2 2 0 ) ) ] in

    for i = 0 to rr - 1 do

     r.(i) <- Matrix.matrix_int_plus x.(i) y.(i)

    done ; 

    r ;;




(** 
poly_gauss_minus polynomial1 polynomial2
 *)
 

let poly_gauss_minus = fun (p:int array array array) (q:int array array array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let r = Array.make rr ( Array.make_matrix 2 2 0 )

   and x = Array.concat [ p ; ( Array.make ( rr - pp ) ( Array.make_matrix 2 2 0 ) ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) ( Array.make_matrix 2 2 0 ) ) ] in

    for i = 0 to rr - 1 do

     r.(i) <- Matrix.matrix_int_minus x.(i) y.(i)

    done ; 

    r ;;




(** 
poly_gauss_mult polynomial1 polynomial2
 *)
 

let poly_gauss_mult = fun (p:int array array array) (q:int array array array) ->

 let pp = Array.length p

 and qq = Array.length q

 and accu = ref ( Array.make_matrix 2 2 0 ) in

  let qqq = qq - 1 in

   let rr = pp + qqq in

    let x = Array.concat [ p ; ( Array.make qq ( Array.make_matrix 2 2 0 ) ) ]

    and y = Array.concat [ q ; ( Array.make pp ( Array.make_matrix 2 2 0 ) ) ]

    and r = Array.make rr ( Array.make_matrix 2 2 0 ) in

     for i = 0 to rr - 1 do

      for j = 0 to i do

       accu := Matrix.matrix_int_plus !accu ( Matrix.matrix_int_prod x.(j) y.( i - j ) ) ;

      done ;

      r.(i) <- !accu ;

      accu := Array.make_matrix 2 2 0 ;

     done ;

     r ;;




(** 
poly_gauss_mult_karatsuba threshold polynomial1 polynomial2
 *)


let rec poly_gauss_mult_karatsuba = fun (threshold:int) (p:int array array array) (q:int array array array) ->

 let l = Array.length p

 and ll = Array.length q in

  let l_l = max l ll in

   if l_l <= threshold then poly_gauss_mult p q

   else

    begin

     let half = ( l_l ) / 2

     and p_p = Array.append p ( Array.make ( l_l - l ) gauss_0 )

     and q_q = Array.append q ( Array.make ( l_l - ll ) gauss_0 ) in

      let pp = Array.sub p_p 0 half

      and ppp = Array.sub p_p half ( l_l - half )

      and qq = Array.sub q_q 0 half

      and qqq = Array.sub q_q half ( l_l - half ) in

       let debut = poly_gauss_mult_karatsuba threshold pp qq

       and fin = poly_gauss_mult_karatsuba threshold ppp qqq

       and psum = poly_gauss_plus pp ppp

       and qsum = poly_gauss_plus qq qqq in

        let mix = poly_gauss_mult_karatsuba threshold psum qsum in

         let inter = poly_gauss_minus mix debut in

          let milieu = poly_gauss_minus inter fin in

           let first = poly_gauss_plus debut ( Array.append ( Array.make ( half ) gauss_0 ) milieu ) in

            let raw_prod = poly_gauss_plus first ( Array.append ( Array.make ( 2 * half ) gauss_0 ) fin ) in

             poly_gauss_cleanup raw_prod

    end ;;




(** 
poly_gauss_pow mult_rule power polynomial
 *)
 

let rec poly_gauss_pow = fun mult_rule (n:int) (p:int array array array) ->

 match n with

  | 0 -> [| gauss_1 |]

  | 1 -> p

  | 2 -> mult_rule p p

  | _ ->

   begin

    let nn = n / 2 in

     let pp = poly_gauss_pow mult_rule nn p in

      let prod = mult_rule pp pp in

       if n mod 2 = 0 then

        prod

       else

        mult_rule prod p

   end ;;




(** 
poly_gauss_finite_prod mult_rule polynomial_array
 *)
 

let rec poly_gauss_finite_prod = fun mult_rule (p:int array array array array) ->

 let n = ( Array.length p ) - 1

 and q = ref p.(0) in

  for i = 1 to n do

   q := mult_rule !q p.(i) ;

  done ;

  !q ;;




(** 
poly_gauss_from_roots mult_rule roots_array
 *)
 

let poly_gauss_from_roots = fun mult_rule (r:int array array array) ->

 let a = Array.map poly_gauss_x_a r in

  poly_gauss_finite_prod mult_rule a ;;




(** 
poly_gauss_horner_comp polynomial1 polynomial2
 *)
 

let poly_gauss_horner_comp = fun (p:int array array array ) (q:int array array array) ->

 let pp = Array.length p in

  let res = ref [| p.( pp - 1 ) |] in 

   for i = pp - 2 downto 0 do

    res := poly_gauss_plus ( poly_gauss_mult !res q ) [| p.(i) |] ;

   done ;

   !res ;;




(** 
poly_gauss_ranged_horner_comp mult_rule index order polynomial1 polynomial2
 *)
 

let poly_gauss_ranged_horner_comp = fun mult_rule (i:int) (l:int) (p:int array array array) (q:int array array array) ->

 let res = ref [| p.( i + l - 1 ) |] in 

  for j = l - 2 downto 0 do

   res := poly_gauss_plus ( mult_rule !res q ) [| p.( i + j ) |] ;

  done ;

  !res ;;






(** 
poly_gauss_brent_kung_hart_novocin_comp mult_rule parameter polynomial1 polynomial2
 The length l must be greater than or equal to 3.
The algorithm comes from the document located at the following address.



http://hal-ens-lyon.archives-ouvertes.fr/docs/00/54/61/02/PDF/dmtcs_NOVOCIN2010.pdf



L'algorithme provient du document situé à l'adresse précédente.
La longueur l doit être supérieure ou égale à 3. *)
 

let poly_gauss_brent_kung_hart_novocin_comp = fun mult_rule (l:int) (p:int array array array) (q:int array array array) ->

 let n = ( Array.length p ) - 1

 and g = ref ( poly_gauss_pow mult_rule l q ) in

  let k = ref ( ( n + 1 ) / l + 1 ) in

   let pp = Array.append p ( Array.make ( !k * l - n ) gauss_0 ) in

    k := ( 1 + ( Array.length pp ) ) / l ;

    let h = Array.make_matrix ( ( !k + l ) * 2 ) 1 gauss_0

    and hh = Array.make_matrix ( ( !k + l ) * 2 ) 1 gauss_0 in 

     for j = 0 to !k - 1 do

      h.(j) <- poly_gauss_ranged_horner_comp mult_rule ( j * l ) l pp q ;

     done ;

     while !k > 1 do

      k := ( !k + 1 )/ 2 ;

      for j = 0 to !k do

       hh.(j) <- poly_gauss_plus h.( 2 * j ) ( mult_rule !g h.( 2 * j + 1 ) )

      done ;

      for j = 0 to !k - 1 do

       h.(j) <- poly_gauss_copy hh.(j) ;

      done ;

      if !k > 1 then g := mult_rule !g !g ;

     done ;

     h.(0) ;;




(** 
poly_gauss_evaluate comp_rule polynomial gauss_integer
 *)


let poly_gauss_evaluate = fun comp_rule (p:int array array array) (x0:int array array) ->

 ( comp_rule p [| x0 |] ).(0) ;;






(** 
gauss_sylvester_matrix polynomial1 polynomial2
 *)


let gauss_sylvester_matrix = fun (p:int array array array) (q:int array array array) ->

 let dp = int_of_float ( poly_gauss_deg p )

 and dq = int_of_float ( poly_gauss_deg q ) in

  let dd = dp + dq in

   let ddd = 2 * dd in

    let m = Array.make_matrix ddd ddd 0 in

     for i = 0 to pred dq do

      let first_row = m.(i)

      and second_row = m.( dd + i )

      and ii = i + dp in

       for j = i to ii do

        let jj = dd + j in

         first_row.(j) <- gauss_real_part p.( ii - j ) ;

         first_row.(jj) <- - gauss_imaginary_part p.( ii - j ) ;

         second_row.(j) <- gauss_imaginary_part p.( ii - j ) ;

         second_row.(jj) <- gauss_real_part p.( ii - j ) ;

       done ;

     done ;

     for i = 0 to pred dp do

      let ii = i + dq in

       let first_row = m.(ii)

       and second_row = m.( dd + ii ) in

        for j = i to ii do

         let jj = dd + j in

          first_row.(j) <- gauss_real_part q.( ii - j ) ;

          first_row.(jj) <- - gauss_imaginary_part q.( ii - j ) ;

          second_row.(j) <- gauss_imaginary_part q.( ii - j ) ;

          second_row.(jj) <- gauss_real_part q.( ii - j ) ;

        done ;

     done ;

     m ;;




(** 
gauss_resultant det_methode polynomial1 polynomial2
 *)


let gauss_resultant = fun det_methode (p:int array array array) (q:int array array array) ->

 let m = gauss_sylvester_matrix p q in

  det_methode m ;;




(** 
gauss_discriminant det_methode polynomial
 *)


let gauss_discriminant = fun det_methode (p:int array array array) ->

 gauss_resultant det_methode p ( poly_gauss_deriv p ) ;;










(** 

Polynômes à coefficients en précision étendue


Polynomials with coefficients in extended precision

*)



(** 
 
 *)











(** 
poly_sci_deg polynomial
 *)
 

let poly_sci_deg = function (p:Num.num array array) ->

 let r = ref ( ( Array.length p ) - 1 )

 and deg = ref neg_infinity in

  if !r >= 0 then 

   begin

    while !r >= 0 do

     begin 

      let coeff = Sci.square_module p.(!r) in

       if Sci.not_eq_0 coeff then ( deg := float !r ; r := -1 )

       else r := !r - 1 ;

     end

    done ;

   end ;

   !deg ;;




(** 
poly_sci_val polynomial
 *)
 

let poly_sci_val = function (p:Num.num array array) ->

 let rr = ( ( Array.length p ) - 1 )

 and r = ref 0

 and valuation = ref infinity in

  if !r <= rr then 

   begin

    while !r <= rr do

     begin

      let coeff = Sci.square_module p.(!r) in

       if Sci.not_eq_0 coeff then ( valuation := float !r ; r := max_int )

       else r := !r + 1 ;

     end

    done ;

   end ;

   !valuation ;;




(** 
poly_sci_cleanup polynomial
 *)


let poly_sci_cleanup = function (p:Num.num array array) ->

 let d = poly_sci_deg p in

  if d < 0. then [| Sci.sci_0 |]

  else

   begin

    let dd = int_of_float d in

     let q = Array.make ( dd + 1 ) Sci.sci_0 in

      for i = 0 to dd do

       q.(i) <- p.(i) ;

      done ;

      q ;

   end ;;




(** 
poly_sci_normalize polynomial
 *)


let poly_sci_normalize = function (p:Num.num array array) ->

 let d = poly_sci_deg p in

  if d < 0. then [| Sci.sci_0 |]

  else

   begin

    let dd = int_of_float d in

     let q = Array.make ( dd + 1 ) Sci.sci_1

     and coeff = Sci.inv p.(dd) in

      for i = 0 to dd - 1 do

       q.(i) <- Sci.mult p.(i) coeff ;

      done ;

      q ;

   end ;;




(** 
poly_sci_copy polynomial
 *)


let poly_sci_copy = function (p:Num.num array array) ->

 let r = Array.length p in

  let q = Array.make r Sci.sci_0 in

   for i = 0 to r - 1 do

    q.(i) <- Sci.sci_copy p.(i)

   done ;

   q ;;




(** 
poly_sci_deriv polynomial
 *)
 

let poly_sci_deriv = function (p:Num.num array array) ->

 let pp = ( Array.length p ) - 1 in

  let r = Array.make pp Sci.sci_0 in

   for i = 1 to pp do

    r.( i - 1 ) <- Sci.mult ( Sci.sci_of_int i ) p.(i)

   done ;

   r ;;




(** 
poly_sci_plus polynomial1 polynomial2
 *)
 

let poly_sci_plus = fun (p:Num.num array array) (q:Num.num array array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let r = Array.make rr Sci.sci_0

   and x = Array.concat [ p ; ( Array.make ( rr - pp ) Sci.sci_0 ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) Sci.sci_0 ) ] in

    for i = 0 to rr - 1 do

     r.(i) <- Sci.plus x.(i) y.(i)

    done ; 

    r ;;




(** 
poly_sci_minus polynomial1 polynomial2
 *)
 

let poly_sci_minus = fun (p:Num.num array array) (q:Num.num array array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let r = Array.make rr Sci.sci_0

   and x = Array.concat [ p ; ( Array.make ( rr - pp ) Sci.sci_0 ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) Sci.sci_0 ) ] in

    for i = 0 to rr - 1 do

     r.(i) <- Sci.minus x.(i) y.(i)

    done ; 

    r ;;




(** 
poly_sci_mult polynomial1 polynomial2
 *)
 

let poly_sci_mult = fun (p:Num.num array array) (q:Num.num array array) ->

 let pp = Array.length p

 and qq = Array.length q

 and accu = ref Sci.sci_0 in

  let qqq = qq - 1 in

   let rr = pp + qqq in

    let x = Array.concat [ p ; ( Array.make qq Sci.sci_0 ) ]

    and y = Array.concat [ q ; ( Array.make pp Sci.sci_0 ) ]

    and r = Array.make rr Sci.sci_0 in

     for i = 0 to rr - 1 do

      for j = 0 to i do

       accu := Sci.plus !accu ( Sci.mult x.(j) y.( i - j ) ) ;

      done ;

      r.(i) <- !accu ;

      accu := Sci.sci_0 ;

     done ;

     r ;;




(** 
poly_sci_mult_karatsuba threshold polynomial1 polynomial2
 *)


let rec poly_sci_mult_karatsuba = fun (threshold:int) (p:Num.num array array) (q:Num.num array array) ->

 let l = Array.length p

 and ll = Array.length q in

  let l_l = max l ll in

   if l_l <= threshold then poly_sci_mult p q

   else

    begin

     let half = ( l_l ) / 2

     and p_p = Array.append p ( Array.make ( l_l - l ) Sci.sci_0 )

     and q_q = Array.append q ( Array.make ( l_l - ll ) Sci.sci_0 ) in

      let pp = Array.sub p_p 0 half

      and ppp = Array.sub p_p half ( l_l - half )

      and qq = Array.sub q_q 0 half

      and qqq = Array.sub q_q half ( l_l - half ) in

       let debut = poly_sci_mult_karatsuba threshold pp qq

       and fin = poly_sci_mult_karatsuba threshold ppp qqq

       and psum = poly_sci_plus pp ppp

       and qsum = poly_sci_plus qq qqq in

        let mix = poly_sci_mult_karatsuba threshold psum qsum in

         let inter = poly_sci_minus mix debut in

          let milieu = poly_sci_minus inter fin in

           let first = poly_sci_plus debut ( Array.append ( Array.make ( half ) Sci.sci_0 ) milieu ) in

            let raw_prod = poly_sci_plus first ( Array.append ( Array.make ( 2 * half ) Sci.sci_0 ) fin ) in

             poly_sci_cleanup raw_prod

    end ;;




(** 
poly_sci_pow mult_rule power polynomial
 *)
 

let rec poly_sci_pow = fun mult_rule (n:int) (p:Num.num array array) ->

 match n with

  | 0 -> [| Sci.sci_1 |]

  | 1 -> p

  | 2 -> mult_rule p p

  | _ ->

   begin

    let nn = n / 2 in

     let pp = poly_sci_pow mult_rule nn p in

     let prod = mult_rule pp pp in

      if n mod 2 = 0 then

       prod

      else

       mult_rule prod p

   end ;;




(** 
poly_sci_finite_prod mult_rule polynomial_array
 *)
 

let rec poly_sci_finite_prod = fun mult_rule (p:Num.num array array array) ->

 let n = ( Array.length p ) - 1

 and q = ref p.(0) in

  for i = 1 to n do

   q := mult_rule !q p.(i) ;

  done ;

  !q ;;




(** 
poly_sci_from_roots mult_rule roots_array
 *)
 

let poly_sci_from_roots = fun mult_rule (r:Num.num array array) ->

 let a = Array.map poly_sci_x_a r in

  poly_sci_finite_prod mult_rule a ;;




(** 
poly_sci_horner_comp polynomial1 polynomial2
 *)
 

let poly_sci_horner_comp = fun (p:Num.num array array ) (q:Num.num array array) ->

 let pp = Array.length p in

  let res = ref ( Array.make 1 ( Sci.sci_copy p.( pp - 1 ) ) ) in 

   for i = pp - 2 downto 0 do

    res := poly_sci_plus ( poly_sci_mult !res q ) ( Array.make 1 ( Sci.sci_copy p.(i) ) ) ;

   done ;

   !res ;;




(** 
poly_sci_ranged_horner_comp mult_rule index order polynomial1 polynomial2
 *)
 

let poly_sci_ranged_horner_comp = fun mult_rule (i:int) (l:int) (p:Num.num array array) (q:Num.num array array) ->

 let res = ref ( Array.make 1 ( Sci.sci_copy p.( i + l - 1 ) ) ) in 

  for j = l - 2 downto 0 do

   res := poly_sci_plus ( mult_rule !res q ) ( Array.make 1 ( Sci.sci_copy p.( i + j ) ) ) ;

  done ;

  !res ;;






(** 
poly_sci_brent_kung_hart_novocin_comp mult_rule parameter polynomial1 polynomial2
 The length l must be greater than or equal to 3.
The algorithm comes from the document located at the following address.



http://hal-ens-lyon.archives-ouvertes.fr/docs/00/54/61/02/PDF/dmtcs_NOVOCIN2010.pdf



L'algorithme provient du document situé à l'adresse précédente.
La longueur l doit être supérieure ou égale à 3. *)
 

let poly_sci_brent_kung_hart_novocin_comp = fun mult_rule (l:int) (p:Num.num array array) (q:Num.num array array) ->

 let n = ( Array.length p ) - 1

 and g = ref ( poly_sci_pow mult_rule l q ) in

  let k = ref ( ( n + 1 ) / l + 1 ) in

   let pp = Array.append p ( Array.make ( !k * l - n ) Sci.sci_0 ) in

    k := ( 1 + ( Array.length pp ) ) / l ;

    let h = Array.make_matrix ( ( !k + l ) * 2 ) 1 Sci.sci_0

    and hh = Array.make_matrix ( ( !k + l ) * 2 ) 1 Sci.sci_0 in 

     for j = 0 to !k - 1 do

      h.(j) <- poly_sci_ranged_horner_comp mult_rule ( j * l ) l pp q ;

     done ;

     while !k > 1 do

      k := ( !k + 1 )/ 2 ;

      for j = 0 to !k do

       hh.(j) <- poly_sci_plus h.( 2 * j ) ( mult_rule !g h.( 2 * j + 1 ) )

      done ;

      for j = 0 to !k - 1 do

       h.(j) <- poly_sci_copy hh.(j) ;

      done ;

      if !k > 1 then g := mult_rule !g !g ;

     done ;

     h.(0) ;;




(** 
poly_sci_evaluate comp_rule polynomial complex
 *)


let poly_sci_evaluate = fun comp_rule (p:Num.num array array) (x0:Num.num array) ->

 ( comp_rule p [| x0 |] ).(0) ;;




(** 
poly_sci_eq_0 polynomial
 *)


let poly_sci_eq_0 = function (p:Num.num array array) ->

 Array.fold_left (&&) true ( Array.map ( function x -> ( Sci.square_module x ).(0) = Sci.num_0 ) p ) ;;




(** 
poly_sci_eq polynomial1 polynomial2
 *)


let poly_sci_eq = fun (p:Num.num array array) (q:Num.num array array) ->

 poly_sci_eq_0 ( poly_sci_minus p q ) ;;










(** 

Polynômes à coefficients en précision intermédiaire


Polynomials with coefficients in intermediate precision

*)



(** 
 
 *)











(** 
poly_sci_1024_normalize polynomial
 *)


let poly_sci_1024_normalize = function (p:Num.num array array) ->

 let d = poly_sci_deg p in

  if d < 0. then [| Sci.sci_0 |]

  else

   begin

    let dd = int_of_float d in

     let q = Array.make ( dd + 1 ) Sci.sci_1

     and coeff = Sci.inv_1024 p.(dd) in

      for i = 0 to dd - 1 do

       q.(i) <- Sci.mult_1024 p.(i) coeff ;

      done ;

      q ;

   end ;;




(** 
poly_sci_1024_deriv polynomial
 *)
 

let poly_sci_1024_deriv = function (p:Num.num array array) ->

 let pp = ( Array.length p ) - 1 in

  let r = Array.make pp Sci.sci_0 in

   for i = 1 to pp do

    r.( i - 1 ) <- Sci.mult_1024 ( Sci.sci_of_int i ) p.(i)

   done ;

   r ;;




(** 
poly_sci_1024_plus polynomial1 polynomial2
 *)
 

let poly_sci_1024_plus = fun (p:Num.num array array) (q:Num.num array array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let r = Array.make rr Sci.sci_0

   and x = Array.concat [ p ; ( Array.make ( rr - pp ) Sci.sci_0 ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) Sci.sci_0 ) ] in

    for i = 0 to rr - 1 do

     r.(i) <- Sci.plus_1024 x.(i) y.(i)

    done ; 

    r ;;




(** 
poly_sci_1024_minus polynomial1 polynomial2
 *)
 

let poly_sci_1024_minus = fun (p:Num.num array array) (q:Num.num array array) ->

 let pp = Array.length p

 and qq = Array.length q in

  let rr = max pp qq in

   let r = Array.make rr Sci.sci_0

   and x = Array.concat [ p ; ( Array.make ( rr - pp ) Sci.sci_0 ) ]

   and y = Array.concat [ q ; ( Array.make ( rr - qq ) Sci.sci_0 ) ] in

    for i = 0 to rr - 1 do

     r.(i) <- Sci.minus_1024 x.(i) y.(i)

    done ; 

    r ;;




(** 
poly_sci_1024_mult polynomial1 polynomial2
 *)
 

let poly_sci_1024_mult = fun (p:Num.num array array) (q:Num.num array array) ->

 let pp = Array.length p

 and qq = Array.length q

 and accu = ref Sci.sci_0 in

  let qqq = qq - 1 in

   let rr = pp + qqq in

    let x = Array.concat [ p ; ( Array.make qq Sci.sci_0 ) ]

    and y = Array.concat [ q ; ( Array.make pp Sci.sci_0 ) ]

    and r = Array.make rr Sci.sci_0 in

     for i = 0 to rr - 1 do

      for j = 0 to i do

       accu := Sci.plus_1024 !accu ( Sci.mult_1024 x.(j) y.( i - j ) ) ;

      done ;

      r.(i) <- !accu ;

      accu := Sci.sci_0 ;

     done ;

     r ;;




(** 
poly_sci_1024_mult_karatsuba threshold polynomial1 polynomial2
 *)


let rec poly_sci_1024_mult_karatsuba = fun (threshold:int) (p:Num.num array array) (q:Num.num array array) ->

 let l = Array.length p

 and ll = Array.length q in

  let l_l = max l ll in

   if l_l <= threshold then poly_sci_1024_mult p q

   else

    begin

     let half = ( l_l ) / 2

     and p_p = Array.append p ( Array.make ( l_l - l ) Sci.sci_0 )

     and q_q = Array.append q ( Array.make ( l_l - ll ) Sci.sci_0 ) in

      let pp = Array.sub p_p 0 half

      and ppp = Array.sub p_p half ( l_l - half )

      and qq = Array.sub q_q 0 half

      and qqq = Array.sub q_q half ( l_l - half ) in

       let debut = poly_sci_1024_mult_karatsuba threshold pp qq

       and fin = poly_sci_1024_mult_karatsuba threshold ppp qqq

       and psum = poly_sci_1024_plus pp ppp

       and qsum = poly_sci_1024_plus qq qqq in

        let mix = poly_sci_1024_mult_karatsuba threshold psum qsum in

         let inter = poly_sci_1024_minus mix debut in

          let milieu = poly_sci_1024_minus inter fin in

           let first = poly_sci_1024_plus debut ( Array.append ( Array.make ( half ) Sci.sci_0 ) milieu ) in

            let raw_prod = poly_sci_1024_plus first ( Array.append ( Array.make ( 2 * half ) Sci.sci_0 ) fin ) in

             poly_sci_cleanup raw_prod

    end ;;




(** 
poly_sci_1024_pow mult_rule power polynomial
 *)
 

let rec poly_sci_1024_pow = fun mult_rule (n:int) (p:Num.num array array) ->

 match n with

  | 0 -> [| Sci.sci_1 |]

  | 1 -> p

  | 2 -> mult_rule p p

  | _ ->

   begin

    let nn = n / 2 in

     let pp = poly_sci_1024_pow mult_rule nn p in

      let prod = mult_rule pp pp in

       if n mod 2 = 0 then

        prod

       else

        mult_rule prod p

   end ;;




(** 
poly_sci_1024_finite_prod mult_rule polynomial_array
 *)
 

let rec poly_sci_1024_finite_prod = fun mult_rule (p:Num.num array array array) ->

 let n = ( Array.length p ) - 1

 and q = ref p.(0) in

  for i = 1 to n do

   q := mult_rule !q p.(i) ;

  done ;

  !q ;;




(** 
poly_sci_1024_from_roots mult_rule roots_array
 *)
 

let poly_sci_1024_from_roots = fun mult_rule (r:Num.num array array) ->

 let a = Array.map poly_sci_x_a r in

  poly_sci_1024_finite_prod mult_rule a ;;




(** 
poly_sci_1024_horner_comp polynomial1 polynomial2
 *)
 

let poly_sci_1024_horner_comp = fun (p:Num.num array array ) (q:Num.num array array) ->

 let pp = Array.length p in

  let res = ref ( Array.make 1 ( Sci.sci_copy p.( pp - 1 ) ) ) in 

   for i = pp - 2 downto 0 do

    res := poly_sci_1024_plus ( poly_sci_1024_mult !res q ) ( Array.make 1 ( Sci.sci_copy p.(i) ) ) ;

   done ;

   !res ;;




(** 
poly_sci_1024_ranged_horner_comp mult_rule index order polynomial1 polynomial2
 *)
 

let poly_sci_1024_ranged_horner_comp = fun mult_rule (i:int) (l:int) (p:Num.num array array) (q:Num.num array array) ->

 let res = ref ( Array.make 1 ( Sci.sci_copy p.( i + l - 1 ) ) ) in 

  for j = l - 2 downto 0 do

   res := poly_sci_1024_plus ( mult_rule !res q ) ( Array.make 1 ( Sci.sci_copy p.( i + j ) ) ) ;

  done ;

  !res ;;






(** 
poly_sci_1024_brent_kung_hart_novocin_comp mult_rule parameter polynomial1 polynomial2
 The length l must be greater than or equal to 3.
The algorithm comes from the document located at the following address.



http://hal-ens-lyon.archives-ouvertes.fr/docs/00/54/61/02/PDF/dmtcs_NOVOCIN2010.pdf



L'algorithme provient du document situé à l'adresse précédente.
La longueur l doit être supérieure ou égale à 3. *)
 

let poly_sci_1024_brent_kung_hart_novocin_comp = fun mult_rule (l:int) (p:Num.num array array) (q:Num.num array array) ->

 let n = ( Array.length p ) - 1

 and g = ref ( poly_sci_1024_pow mult_rule l q ) in

  let k = ref ( ( n + 1 ) / l + 1 ) in

   let pp = Array.append p ( Array.make ( !k * l - n ) Sci.sci_0 ) in

    k := ( 1 + ( Array.length pp ) ) / l ;

    let h = Array.make_matrix ( ( !k + l ) * 2 ) 1 Sci.sci_0

    and hh = Array.make_matrix ( ( !k + l ) * 2 ) 1 Sci.sci_0 in 

     for j = 0 to !k - 1 do

      h.(j) <- poly_sci_1024_ranged_horner_comp mult_rule ( j * l ) l pp q ;

     done ;

     while !k > 1 do

      k := ( !k + 1 )/ 2 ;

      for j = 0 to !k do

       hh.(j) <- poly_sci_1024_plus h.( 2 * j ) ( mult_rule !g h.( 2 * j + 1 ) )

      done ;

      for j = 0 to !k - 1 do

       h.(j) <- poly_sci_copy hh.(j) ;

      done ;

      if !k > 1 then g := mult_rule !g !g ;

     done ;

     h.(0) ;;




(** 
poly_sci_1024_evaluate comp_rule polynomial complex
 *)


let poly_sci_1024_evaluate = fun comp_rule (p:Num.num array array) (x0:Num.num array) ->

 ( comp_rule p [| x0 |] ).(0) ;;




(** 
poly_sci_1024_eq_0 polynomial
 *)


let poly_sci_1024_eq_0 = function (p:Num.num array array) ->

 Array.fold_left (&&) true ( Array.map ( function x -> ( Sci.square_module_1024 x ).(0) = Sci.num_0 ) p ) ;;




(** 
poly_sci_1024_eq polynomial1 polynomial2
 *)


let poly_sci_1024_eq = fun (p:Num.num array array) (q:Num.num array array) ->

 poly_sci_1024_eq_0 ( poly_sci_1024_minus p q ) ;;










(** 

Conversions de types


Type conversions

*)



(** 
 
 *)











(** 
poly_real_to_complex polynomial
 *)


let poly_real_to_complex = function (p:float array) ->

 let f = function x -> Matrix.scal_float 2 2 x in

  Array.map f p ;;




(** 
poly_int_to_gauss polynomial
 *)


let poly_int_to_gauss = function (p:int array) ->

 let f = function x -> Matrix.scal_int 2 2 x in

  Array.map f p ;;




(** 
poly_complex_to_sci polynomial
 *)


let poly_complex_to_sci = function (p:float array array array) ->

 let f = function x -> Sci.sci_of_complex x in

  Array.map f p ;;




(** 
poly_sci_to_complex polynomial
 *)


let poly_sci_to_complex = function (p:Num.num array array) ->

 let f = function x -> Sci.complex_of_sci x in

  Array.map f p ;;




(** 
poly_real_to_sci polynomial
 *)


let poly_real_to_sci = function (p:float array) ->

poly_complex_to_sci ( poly_real_to_complex p ) ;;




(** 
poly_complex_real_part polynomial
 *)


let poly_complex_real_part = function (p:float array array array) ->

 let f = function x -> x.(0).(0) in

  Array.map f p ;;




(** 
poly_complex_imag_part polynomial
 *)


let poly_complex_imag_part = function (p:float array array array) ->

 let f = function x -> x.(1).(0) in

  Array.map f p ;;




(** 
poly_gauss_real_part polynomial
 *)


let poly_gauss_real_part = function (p:int array array array) ->

 let f = function x -> x.(0).(0) in

  Array.map f p ;;




(** 
poly_gauss_imag_part polynomial
 *)


let poly_gauss_imag_part = function (p:int array array array) ->

 let f = function x -> x.(0).(0) in

  Array.map f p ;;




(** 
poly_sci_real_part polynomial
 *)


let poly_sci_real_part = function (p:Num.num array array) ->

 let f = function x -> ( Sci.complex_of_sci x ).(0).(0) in

  Array.map f p ;;




(** 
poly_sci_imag_part polynomial
 *)


let poly_sci_imag_part = function (p:Num.num array array) ->

 let f = function x -> ( Sci.complex_of_sci x ).(1).(0) in

  Array.map f p ;;










(** 
§ 
 *)



(** 

Opérations arithmétiques sur les polynômes


Arithmetic operations on polynomials

*)



(** 
 
 *)











(** 

Polynômes à coefficients réels


Polynomials with real coefficients

*)



(** 
 
 *)











(** 
poly_real_div polynomial1 polynomial2
 Output: quotient, remainder.



Sortie : quotient, reste. *)
 

let poly_real_div = fun (p:float array) (d:float array) ->

 let ddd = poly_real_deg d

 and r = Matrix.vector_float_copy p in

  if ddd < 0. then failwith "Division by zero in Reduc.poly_real_div."

  else

   let dd = int_of_float ddd

   and dr = ref ( poly_real_deg r ) in

    let dominant = d.(dd)

    and q = Array.make ( max 1 ( ( int_of_float !dr ) - dd + 1 ) ) 0. in

     while !dr >= ddd do

      begin

       let place = int_of_float ( !dr ) - dd

       and drdr = int_of_float ( !dr ) in

        let coeff = r.( drdr ) /. dominant in

         q.(place) <- coeff ;

         for i = drdr - 1 downto place do

          r.(i) <- r.(i) -. coeff *. d.( i - place )

         done ;

         r.(drdr) <- 0. ;

         dr := poly_real_deg r ;

      end ;

     done ;

     [| q ; r |] ;;






(** 
poly_real_div_inc order polynomial1 polynomial2
 Output: quotient, remainder.



Sortie : quotient, reste. *)
 

let poly_real_div_inc = fun (order:int) (p:float array) (d:float array) ->

 let ddd = poly_real_deg d

 and oo = float order

 and dp = int_of_float ( poly_real_deg p ) in

  if ( d.(0) = 0. ) then failwith "Bad divisor in Reduc.poly_real_div_inc."

  else

   let dd = int_of_float ddd in

    let r = Array.make ( order + dp + dd + 1 ) 0. in

     for i = 0 to dp do

      r.(i) <- p.(i) ;

     done ;

     let vr = ref ( poly_real_val r )

     and dominant = d.(0) in

      let q = Array.make ( order + 1 ) 0. in

       while !vr <= oo do

        begin

         let vrvr = int_of_float ( !vr ) in

          let place = vrvr + dd

          and coeff = r.(vrvr) /. dominant in

           q.(vrvr) <- coeff ;

          for i = vrvr + 1 to place do

           r.(i) <- r.(i) -. coeff *. d.( i - vrvr )

          done ;

          r.(vrvr) <- 0. ;

          vr := poly_real_val r ;

        end ;

       done ;

       [| q ; r |] ;;






(** 
poly_real_mod polynomial1 polynomial2
 *)
 

let poly_real_mod = fun (p:float array) (q:float array) ->

 poly_real_cleanup ( poly_real_div p q ).(1) ;;






(** 
poly_real_gcd polynomial1 polynomial2
 *)
 

let poly_real_gcd = fun (p:float array) (q:float array) ->

 let r = poly_real_mod p q

 and s = poly_real_mod q p

 and pp = ref p

 and ppp = ref p

 and qq = ref q in

  let rr = poly_real_deg r

  and ss = poly_real_deg s in

   if rr = neg_infinity then poly_real_normalize q

   else

    begin

     if ss = neg_infinity then poly_real_normalize p

     else

      begin

       if rr < ss then ( pp := q ; qq := r )

       else ( qq := s ) ; 

        while poly_real_deg !qq >= 0. do

         ppp := !qq ;

         qq := poly_real_mod !pp !qq ;

         pp := !ppp ;

        done ;

        poly_real_normalize !pp

      end

    end ;;






(** 
poly_real_bezout mult_rule polynomial1 polynomial2
 The output yields in that order
the gcd d and the Bézout coefficients u and v such that up+vq=d.



La sortie fournit dans l'ordre le pgcd d et les coefficients de Bézout u et v tels que up+vq=d. *)
 

let poly_real_bezout = fun mult_rule (p:float array) (q:float array) ->

 let r = poly_real_div p q

 and s = poly_real_div q p

 and pp = ref p

 and qqq = ref q

 and qq = ref q in

  let u = ref [| 1. |]

  and v = ref [| 0. |]

  and uu = ref [| 0. |]

  and vv = ref [| 1. |]

  and uuu = ref [| 1. |]

  and vvv = ref [| 0. |]

  and rr = poly_real_deg r.(1)

  and ss = poly_real_deg s.(1) in

   if rr = neg_infinity then

    begin

     let degre = poly_real_deg q in

      let x = 1. /. q.( int_of_float degre ) in

       qq := Matrix.vector_float_scal_mult x q ;

       uu := [| 1. |] ;

       vv := poly_real_minus [| x |] r.(0) ;

       [| !qq ; !uu ; !vv |]

    end

   else

    begin

     if ss = neg_infinity then

      begin

       let degre = poly_real_deg p in

        let x = 1. /. p.( int_of_float degre ) in

         pp := Matrix.vector_float_scal_mult x p ;

         vv := [| 1. |] ;

         uu := poly_real_minus [| x |] s.(0) ;

         [| !pp ; !uu ; !vv |]

      end

     else

      begin

       while poly_real_deg !qq >= 0. do

        let d = poly_real_div !pp !qq in

         qqq := d.(1) ;

         pp := !qq ;

         qq := !qqq ;

         let dd = d.(0) in

          uuu := poly_real_minus !u ( mult_rule dd !uu ) ;

          u := !uu ;

          uu := !uuu ;

          vvv := poly_real_minus !v ( mult_rule dd !vv ) ;

          v := !vv ;

          vv := !vvv ;

       done ;

       let degre = poly_real_deg !pp in

        let x = 1. /. !pp.( int_of_float degre ) in

         pp := Matrix.vector_float_scal_mult x !pp ;

         u := Matrix.vector_float_scal_mult x !u ;

         v := Matrix.vector_float_scal_mult x !v ;

         [| !pp ; !u ; !v |]

      end

    end ;;






(** 
poly_real_lcm mult_rule polynomial1 polynomial2
 *)
 

let poly_real_lcm = fun mult_rule (p:float array) (q:float array) ->

 let d = poly_real_gcd p q

 and pq = mult_rule p q in

  ( poly_real_div pq d ).(0) ;;






(** 
poly_real_simplify polynomial
 *)


let poly_real_simplify = function (p:float array) ->

 let dp = poly_real_deriv p in

  let g = poly_real_gcd p dp in

   ( poly_real_div p g ).(0) ;;










(** 

Polynômes à coefficients complexes


Polynomials with complex coefficients

*)



(** 
 
 *)











(** 
poly_complex_div polynomial1 polynomial2
 Output: quotient, remainder.



Sortie : quotient, reste. *)
 

let poly_complex_div = fun (p:float array array array) (d:float array array array) ->

 let ddd = poly_complex_deg d

 and r = poly_complex_copy p in

  if ddd < 0. then failwith "Division by zero in Reduc.poly_complex_div."

  else

   let dd = int_of_float ddd

   and dr = ref ( poly_complex_deg r ) in

    let dominant = complex_inv d.(dd)

    and q = Array.make ( max 1 ( ( int_of_float !dr ) - dd + 1 ) ) complex_0 in

     while !dr >= ddd do

      begin

       let place = int_of_float ( !dr ) - dd

       and drdr = int_of_float ( !dr ) in

        let coeff = Matrix.matrix_float_prod r.( drdr ) dominant in

         q.(place) <- coeff ;

         for i = drdr - 1 downto place do

          r.(i) <- Matrix.matrix_float_minus r.(i) ( Matrix.matrix_float_prod coeff d.( i - place ) )

         done ;

         r.(drdr) <- complex_0 ;

         dr := poly_complex_deg r ;

      end ;

     done ;

     [| q ; r |] ;;






(** 
poly_complex_div_inc order polynomial1 polynomial2
 Output: quotient, remainder.



Sortie : quotient, reste. *)
 

let poly_complex_div_inc = fun (order:int) (p:float array array array) (d:float array array array) ->

 let ddd = poly_complex_deg d

 and oo = float order

 and dp = int_of_float ( poly_complex_deg p ) in

  if ( Matrix.matrix_float_norm_inf d.(0) = 0. ) then failwith "Bad divisor in Reduc.poly_complex_div_inc."

  else

   let dd = int_of_float ddd in

    let r = Array.make ( order + dp + dd + 1 ) complex_0 in

     for i = 0 to dp do

      r.(i) <- p.(i) ;

     done ;

     let vr = ref ( poly_complex_val r )

     and dominant = complex_inv d.(0) in

      let q = Array.make ( order + 1 ) complex_0 in

       while !vr <= oo do

        begin

         let vrvr = int_of_float ( !vr ) in

          let place = vrvr + dd

          and coeff = Matrix.matrix_float_prod r.(vrvr) dominant in

           q.(vrvr) <- coeff ;

          for i = vrvr + 1 to place do

           r.(i) <- Matrix.matrix_float_minus r.(i) ( Matrix.matrix_float_prod coeff d.( i - vrvr ) )

          done ;

          r.(vrvr) <- complex_0 ;

          vr := poly_complex_val r ;

        end ;

       done ;

       [| q ; r |] ;;






(** 
poly_complex_mod polynomial1 polynomial2
 *)
 

let poly_complex_mod = fun (p:float array array array) (q:float array array array) ->

 poly_complex_cleanup ( poly_complex_div p q ).(1) ;;






(** 
poly_complex_gcd polynomial1 polynomial2
 *)
 

let poly_complex_gcd = fun (p:float array array array) (q:float array array array) ->

 let r = poly_complex_mod p q

 and s = poly_complex_mod q p

 and pp = ref p

 and ppp = ref p

 and qq = ref q in

  let rr = poly_complex_deg r

  and ss = poly_complex_deg s in

   if rr = neg_infinity then poly_complex_normalize q

   else

    begin

     if ss = neg_infinity then poly_complex_normalize p

     else

      begin

       if rr < ss then ( pp := q ; qq := r )

       else ( qq := s ) ; 

        while poly_complex_deg !qq >= 0. do

         ppp := !qq ;

         qq := poly_complex_mod !pp !qq ;

         pp := !ppp ;

        done ;

        poly_complex_normalize !pp

      end

    end ;;






(** 
poly_complex_bezout mult_rule polynomial1 polynomial2
 The output yields in that order
the gcd d and the Bézout coefficients u and v such that up+vq=d.



La sortie fournit dans l'ordre le pgcd d et les coefficients de Bézout u et v tels que up+vq=d. *)
 

let poly_complex_bezout = fun mult_rule (p:float array array array) (q:float array array array) ->

 let r = poly_complex_div p q

 and s = poly_complex_div q p

 and pp = ref p

 and qqq = ref q

 and qq = ref q in

  let u = ref [| complex_1 |]

  and v = ref [| complex_0 |]

  and uu = ref [| complex_0 |]

  and vv = ref [| complex_1 |]

  and uuu = ref [| complex_1 |]

  and vvv = ref [| complex_0 |]

  and rr = poly_complex_deg r.(1)

  and ss = poly_complex_deg s.(1) in

   if rr = neg_infinity then

    begin

     let degre = poly_complex_deg q in

      let x = complex_inv q.( int_of_float degre ) in

       qq := Array.map ( Matrix.matrix_float_prod x ) q ;

       uu := [| complex_1 |] ;

       vv := poly_complex_minus [| x |] r.(0) ;

       [| !qq ; !uu ; !vv |]

    end

   else

    begin

     if ss = neg_infinity then

      begin

       let degre = poly_complex_deg p in

        let x = complex_inv p.( int_of_float degre ) in

         pp := Array.map ( Matrix.matrix_float_prod x ) p ;

         vv := [| complex_1 |] ;

         uu := poly_complex_minus [| x |] s.(0) ;

         [| !pp ; !uu ; !vv |]

      end

     else

      begin

       while poly_complex_deg !qq >= 0. do

        let d = poly_complex_div !pp !qq in

         qqq := d.(1) ;

         pp := !qq ;

         qq := !qqq ;

         let dd = d.(0) in

          uuu := poly_complex_minus !u ( mult_rule dd !uu ) ;

          u := !uu ;

          uu := !uuu ;

          vvv := poly_complex_minus !v ( mult_rule dd !vv ) ;

          v := !vv ;

          vv := !vvv ;

       done ;

       let degre = poly_complex_deg !pp in

        let x = complex_inv !pp.( int_of_float degre ) in

         pp := vector_complex_scal_mult x !pp ;

         u := vector_complex_scal_mult x !u ;

         v := vector_complex_scal_mult x !v ;

         [| !pp ; !u ; !v |]

      end

    end ;;






(** 
poly_complex_lcm mult_rule polynomial1 polynomial2
 *)
 

let poly_complex_lcm = fun mult_rule (p:float array array array) (q:float array array array) ->

 let d = poly_complex_gcd p q

 and pq = mult_rule p q in

  ( poly_complex_div pq d ).(0) ;;






(** 
poly_complex_simplify polynomial
 *)


let poly_complex_simplify = function (p:float array array array) ->

 let dp = poly_complex_deriv p in

  let g = poly_complex_gcd p dp in

   ( poly_complex_div p g ).(0) ;;










(** 

Polynômes à coefficients en précision étendue


Polynomials with coefficients in extended precision

*)



(** 
 
 *)











(** 
poly_sci_div polynomial1 polynomial2
 Output: quotient, remainder.



Sortie : quotient, reste. *)
 

let poly_sci_div = fun (p:Num.num array array) (d:Num.num array array) ->

 let ddd = poly_sci_deg d

 and r = poly_sci_copy p in

  if ddd < 0. then failwith "Division by zero in Reduc.poly_sci_div."

  else

   let dd = int_of_float ddd

   and dr = ref ( poly_sci_deg r ) in

    let dominant = Sci.inv d.(dd)

    and q = Array.make ( max 1 ( ( int_of_float !dr ) - dd + 1 ) ) Sci.sci_0 in

     while !dr >= ddd do

      begin

       let place = int_of_float ( !dr ) - dd

       and drdr = int_of_float ( !dr ) in

        let coeff = Sci.mult r.( drdr ) dominant in

         q.(place) <- coeff ;

         for i = drdr - 1 downto place do

          r.(i) <- Sci.minus r.(i) ( Sci.mult coeff d.( i - place ) )

         done ;

         r.(drdr) <- Sci.sci_0 ;

         dr := poly_sci_deg r ;

      end ;

     done ;

     [| q ; r |] ;;






(** 
poly_sci_div_inc order polynomial1 polynomial2
 Output: quotient, remainder.



Sortie : quotient, reste. *)
 

let poly_sci_div_inc = fun (order:int) (p:Num.num array array) (d:Num.num array array) ->

 let ddd = poly_sci_deg d

 and oo = float order

 and dp = int_of_float ( poly_sci_deg p ) in

  if Sci.eq_0 ( Sci.square_module d.(0) ) then failwith "Bad divisor in Reduc.poly_sci_div_inc."

  else

   let dd = int_of_float ddd in

    let r = Array.make ( order + dp + dd + 1 ) Sci.sci_0 in

     for i = 0 to dp do

      r.(i) <- p.(i) ;

     done ;

     let vr = ref ( poly_sci_val r )

     and dominant = Sci.inv d.(0) in

      let q = Array.make ( order + 1 ) Sci.sci_0 in

       while !vr <= oo do

        begin

         let vrvr = int_of_float ( !vr ) in

          let place = vrvr + dd

          and coeff = Sci.mult r.(vrvr) dominant in

           q.(vrvr) <- coeff ;

          for i = vrvr + 1 to place do

           r.(i) <- Sci.minus r.(i) ( Sci.mult coeff d.( i - vrvr ) )

          done ;

          r.(vrvr) <- Sci.sci_0 ;

          vr := poly_sci_val r ;

        end ;

       done ;

       [| q ; r |] ;;






(** 
poly_sci_mod polynomial1 polynomial2
 *)
 

let poly_sci_mod = fun (p:Num.num array array) (q:Num.num array array) ->

 poly_sci_cleanup ( poly_sci_div p q ).(1) ;;






(** 
poly_sci_gcd polynomial1 polynomial2
 *)
 

let poly_sci_gcd = fun (p:Num.num array array) (q:Num.num array array) ->

 let r = poly_sci_mod p q

 and s = poly_sci_mod q p

 and pp = ref p

 and ppp = ref p

 and qq = ref q in

  let rr = poly_sci_deg r

  and ss = poly_sci_deg s in

   if rr = neg_infinity then poly_sci_normalize q

   else

    begin

     if ss = neg_infinity then poly_sci_normalize p

     else

      begin

       if rr < ss then ( pp := q ; qq := r )

       else ( qq := s ) ; 

        while poly_sci_deg !qq >= 0. do

         ppp := !qq ;

         qq := poly_sci_mod !pp !qq ;

         pp := !ppp ;

        done ;

        poly_sci_normalize !pp

      end

    end ;;






(** 
poly_sci_bezout mult_rule polynomial1 polynomial2
 The output yields in that order
the gcd d and the Bézout coefficients u and v such that up+vq=d.



La sortie fournit dans l'ordre le pgcd d et les coefficients de Bézout u et v tels que up+vq=d. *)
 

let poly_sci_bezout = fun mult_rule (p:Num.num array array) (q:Num.num array array) ->

 let r = poly_sci_div p q

 and s = poly_sci_div q p

 and pp = ref ( poly_sci_copy p )

 and qqq = ref ( poly_sci_copy q )

 and qq = ref ( poly_sci_copy q ) in

  let u = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_1 ) )

  and v = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_0 ) )

  and uu = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_0 ) )

  and vv = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_1 ) )

  and uuu = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_1 ) )

  and vvv = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_0 ) )

  and rr = poly_sci_deg r.(1)

  and ss = poly_sci_deg s.(1) in

   if rr = neg_infinity then

    begin

     let degre = poly_sci_deg q in

      let x = Sci.inv q.( int_of_float degre ) in

       qq := Array.map ( Sci.mult x ) q ;

       uu := Array.make 1 ( Sci.sci_copy Sci.sci_1 ) ;

       vv := poly_sci_minus ( Array.make 1 ( Sci.sci_copy x ) ) r.(0) ;

       [| !qq ; !uu ; !vv |]

    end

   else

    begin

     if ss = neg_infinity then

      begin

       let degre = poly_sci_deg p in

        let x = Sci.inv p.( int_of_float degre ) in

         pp := Array.map ( Sci.mult x ) p ;

         vv := Array.make 1 ( Sci.sci_copy Sci.sci_1 ) ;

         uu := poly_sci_minus ( Array.make 1 ( Sci.sci_copy x ) ) s.(0) ;

         [| !pp ; !uu ; !vv |]

      end

     else

      begin

       while poly_sci_deg !qq >= 0. do

        let d = poly_sci_div !pp !qq in

         qqq := d.(1) ;

         pp := !qq ;

         qq := !qqq ;

         let dd = d.(0) in

          uuu := poly_sci_minus !u ( mult_rule dd !uu ) ;

          u := !uu ;

          uu := !uuu ;

          vvv := poly_sci_minus !v ( mult_rule dd !vv ) ;

          v := !vv ;

          vv := !vvv ;

       done ;

       let degre = poly_sci_deg !pp in

        let x = Sci.inv !pp.( int_of_float degre ) in

         pp := Array.map ( Sci.mult x ) !pp ;

         u := Array.map ( Sci.mult x ) !u ;

         v := Array.map ( Sci.mult x ) !v ;

         [| !pp ; !u ; !v |]

      end

    end ;;






(** 
poly_sci_lcm mult_rule polynomial1 polynomial2
 *)
 

let poly_sci_lcm = fun mult_rule (p:Num.num array array) (q:Num.num array array) ->

 let d = poly_sci_gcd p q

 and pq = mult_rule p q in

  ( poly_sci_div pq d ).(0) ;;






(** 
poly_sci_simplify polynomial
 *)


let poly_sci_simplify = function (p:Num.num array array) ->

 let dp = poly_sci_deriv p in

  let g = poly_sci_gcd p dp in

   ( poly_sci_div p g ).(0) ;;










(** 

Polynômes à coefficients en précision intermédiaire


Polynomials with coefficients in intermediate precision

*)



(** 
 
 *)











(** 
poly_sci_1024_div polynomial1 polynomial2
 Output: quotient, remainder.



Sortie : quotient, reste. *)
 

let poly_sci_1024_div = fun (p:Num.num array array) (d:Num.num array array) ->

 let ddd = poly_sci_deg d

 and r = poly_sci_copy p in

  if ddd < 0. then failwith "Division by zero in Reduc.poly_sci_1024_div."

  else

   let dd = int_of_float ddd

   and dr = ref ( poly_sci_deg r ) in

    let dominant = Sci.inv_1024 d.(dd)

    and q = Array.make ( max 1 ( ( int_of_float !dr ) - dd + 1 ) ) Sci.sci_0 in

     while !dr >= ddd do

      begin

       let place = int_of_float ( !dr ) - dd

       and drdr = int_of_float ( !dr ) in

        let coeff = Sci.mult_1024 r.( drdr ) dominant in

         q.(place) <- coeff ;

         for i = drdr - 1 downto place do

          r.(i) <- Sci.minus_1024 r.(i) ( Sci.mult_1024 coeff d.( i - place ) )

         done ;

         r.(drdr) <- Sci.sci_0 ;

         dr := poly_sci_deg r ;

      end ;

     done ;

     [| q ; r |] ;;






(** 
poly_sci_1024_div_inc order polynomial1 polynomial2
 Output: quotient, remainder.



Sortie : quotient, reste. *)
 

let poly_sci_1024_div_inc = fun (order:int) (p:Num.num array array) (d:Num.num array array) ->

 let ddd = poly_sci_deg d

 and oo = float order

 and dp = int_of_float ( poly_sci_deg p ) in

  if Sci.eq_0 ( Sci.square_module_1024 d.(0) ) then failwith "Bad divisor in Reduc.poly_sci_1024_div_inc."

  else

   let dd = int_of_float ddd in

    let r = Array.make ( order + dp + dd + 1 ) Sci.sci_0 in

     for i = 0 to dp do

      r.(i) <- p.(i) ;

     done ;

     let vr = ref ( poly_sci_val r )

     and dominant = Sci.inv_1024 d.(0) in

      let q = Array.make ( order + 1 ) Sci.sci_0 in

       while !vr <= oo do

        begin

         let vrvr = int_of_float ( !vr ) in

          let place = vrvr + dd

          and coeff = Sci.mult_1024 r.(vrvr) dominant in

           q.(vrvr) <- coeff ;

          for i = vrvr + 1 to place do

           r.(i) <- Sci.minus_1024 r.(i) ( Sci.mult_1024 coeff d.( i - vrvr ) )

          done ;

          r.(vrvr) <- Sci.sci_0 ;

          vr := poly_sci_val r ;

        end ;

       done ;

       [| q ; r |] ;;






(** 
poly_sci_1024_mod polynomial1 polynomial2
 *)
 

let poly_sci_1024_mod = fun (p:Num.num array array) (q:Num.num array array) ->

 poly_sci_cleanup ( poly_sci_1024_div p q ).(1) ;;






(** 
poly_sci_1024_gcd polynomial1 polynomial2
 *)
 

let poly_sci_1024_gcd = fun (p:Num.num array array) (q:Num.num array array) ->

 let r = poly_sci_1024_mod p q

 and s = poly_sci_1024_mod q p

 and pp = ref p

 and ppp = ref p

 and qq = ref q in

  let rr = poly_sci_deg r

  and ss = poly_sci_deg s in

   if rr = neg_infinity then poly_sci_1024_normalize q

   else

    begin

     if ss = neg_infinity then poly_sci_1024_normalize p

     else

      begin

       if rr < ss then ( pp := q ; qq := r )

       else ( qq := s ) ; 

        while poly_sci_deg !qq >= 0. do

         ppp := !qq ;

         qq := poly_sci_1024_mod !pp !qq ;

         pp := !ppp ;

        done ;

        poly_sci_1024_normalize !pp

      end

    end ;;






(** 
poly_sci_1024_bezout mult_rule polynomial1 polynomial2
 The output yields in that order
the gcd d and the Bézout coefficients u and v such that up+vq=d.



La sortie fournit dans l'ordre le pgcd d et les coefficients de Bézout u et v tels que up+vq=d. *)
 

let poly_sci_1024_bezout = fun mult_rule (p:Num.num array array) (q:Num.num array array) ->

 let r = poly_sci_1024_div p q

 and s = poly_sci_1024_div q p

 and pp = ref ( poly_sci_copy p )

 and qqq = ref ( poly_sci_copy q )

 and qq = ref ( poly_sci_copy q ) in

  let u = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_1 ) )

  and v = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_0 ) )

  and uu = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_0 ) )

  and vv = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_1 ) )

  and uuu = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_1 ) )

  and vvv = ref ( Array.make 1 ( Sci.sci_copy Sci.sci_0 ) )

  and rr = poly_sci_deg r.(1)

  and ss = poly_sci_deg s.(1) in

   if rr = neg_infinity then

    begin

     let degre = poly_sci_deg q in

      let x = Sci.inv_1024 q.( int_of_float degre ) in

       qq := Array.map ( Sci.mult_1024 x ) q ;

       uu := Array.make 1 ( Sci.sci_copy Sci.sci_1 ) ;

       vv := poly_sci_1024_minus ( Array.make 1 ( Sci.sci_copy x ) ) r.(0) ;

       [| !qq ; !uu ; !vv |]

    end

   else

    begin

     if ss = neg_infinity then

      begin

       let degre = poly_sci_deg p in

        let x = Sci.inv_1024 p.( int_of_float degre ) in

         pp := Array.map ( Sci.mult_1024 x ) p ;

         vv := Array.make 1 ( Sci.sci_copy Sci.sci_1 ) ;

         uu := poly_sci_1024_minus ( Array.make 1 ( Sci.sci_copy x ) ) s.(0) ;

         [| !pp ; !uu ; !vv |]

      end

     else

      begin

       while poly_sci_deg !qq >= 0. do

        let d = poly_sci_1024_div !pp !qq in

         qqq := d.(1) ;

         pp := !qq ;

         qq := !qqq ;

         let dd = d.(0) in

          uuu := poly_sci_1024_minus !u ( mult_rule dd !uu ) ;

          u := !uu ;

          uu := !uuu ;

          vvv := poly_sci_1024_minus !v ( mult_rule dd !vv ) ;

          v := !vv ;

          vv := !vvv ;

       done ;

       let degre = poly_sci_deg !pp in

        let x = Sci.inv_1024 !pp.( int_of_float degre ) in

         pp := Array.map ( Sci.mult_1024 x ) !pp ;

         u := Array.map ( Sci.mult_1024 x ) !u ;

         v := Array.map ( Sci.mult_1024 x ) !v ;

         [| !pp ; !u ; !v |]

      end

    end ;;






(** 
poly_sci_1024_lcm mult_rule polynomial1 polynomial2
 *)
 

let poly_sci_1024_lcm = fun mult_rule (p:Num.num array array) (q:Num.num array array) ->

 let d = poly_sci_1024_gcd p q

 and pq = mult_rule p q in

  ( poly_sci_1024_div pq d ).(0) ;;






(** 
poly_sci_1024_simplify polynomial
 *)


let poly_sci_1024_simplify = function (p:Num.num array array) ->

 let dp = poly_sci_1024_deriv p in

  let g = poly_sci_1024_gcd p dp in

   ( poly_sci_1024_div p g ).(0) ;;










(** 
§ 
 *)



(** 

Opérations entre les polynômes et les matrices


Operations between polynomials and matrices

*)



(** 
 
 *)











(** 

Coefficients réels


Real coefficients

*)



(** 
 
 *)











(** 
poly_real_apply_matrix polynomial matrix
 *)


let poly_real_apply_matrix = fun (p:float array) (m:float array array) ->

 let r = Array.length m

 and d = int_of_float ( poly_real_deg p ) in

  let mm = ref ( Matrix.scal_float r r p.(d) ) in

   for i = d - 1 downto 0 do

    mm := Matrix.matrix_float_prod m !mm ;

    mm := Matrix.matrix_float_plus !mm ( Matrix.scal_float r r p.(i) ) ;

   done ;

   !mm ;;




(** 
poly_real_apply_matrix_rec polynomial matrix
 *)


let rec poly_real_apply_matrix_rec = fun (p:float array) (m:float array array) ->

 let d = int_of_float ( poly_real_deg p ) in

  if d <= 3 then poly_real_apply_matrix p m

  else

   begin

    let dd = d / 2 in

     let tail = Array.sub p 0 dd

     and head = Array.sub p dd ( d - dd + 1 )

     and mm = Matrix.float_power dd m in

      let mmm = poly_real_apply_matrix_rec head m in

       Matrix.matrix_float_plus ( poly_real_apply_matrix_rec tail m ) ( Matrix.matrix_float_prod mm mmm )

   end ;;




(** 
real_companion polynomial
 *)


let real_companion = function (p:float array) ->

 let d = int_of_float ( poly_real_deg p ) in

  let q = Array.sub p 0 d

  and coeff = (-1.) /. p.(d) in

   for i = 0 to d - 1 do

    q.(i) <- q.(i) *. coeff

   done ;

   let m = Matrix.identity_float_bis ( d - 1 ) d in

    Array.append m [| q |] ;;




(** 
leverrier_real_char_poly matrix
 *)


let leverrier_real_char_poly = function (m:float array array) ->

 let l = Array.length m in

  let p = Array.make ( l + 1 ) 1.

  and t = ref ( -. Matrix.float_trace m ) in

   let u = ref ( Matrix.matrix_float_plus m ( Matrix.scal_float l l !t ) ) in

    p.( l - 1 ) <- !t ;

    for i = 2 to l do

     let uu = Matrix.matrix_float_prod m !u in

      t := (Matrix.float_trace uu ) /. ( float ( - i ) ) ;

      u := Matrix.matrix_float_plus uu ( Matrix.scal_float l l !t ) ;

      p.( l - i ) <- !t ;

    done ;

    p ;;






(** 
real_poly_det char_poly matrix
 The characteristic polynomial must be provided, 
as for example leverrier_real_char_poly m.



Le polynôme caractéristique doit être précisé, comme par exemple leverrier_real_char_poly m. *)


let real_poly_det = fun (p:float array) (m:float array array) ->

 let x = p.(0) in

  if ( Array.length m ) mod 2 = 0 then x else -. x ;;






(** 
real_resultant_bis characteristic_polynomial_methode polynomial1 polynomial2
 *)


let real_resultant_bis = fun char_poly_methode (p:float array) (q:float array) ->

 let m = real_sylvester_matrix p q in

  let pp = char_poly_methode m in

   real_poly_det pp m ;;






(** 
real_discriminant_bis characteristic_polynomial_methode polynomial
 *)


let real_discriminant_bis = fun char_poly_methode (p:float array) ->

 real_resultant_bis char_poly_methode p ( poly_real_deriv p ) ;;






(** 
matrix_real_inv char_poly matrix
 The characteristic polynomial must be provided, 
as for example leverrier_real_char_poly m.



Le polynôme caractéristique doit être précisé, comme par exemple leverrier_real_char_poly m. *)


let matrix_real_inv = fun (p:float array) (m:float array array) ->

 let x = (-1.) /. p.(0)

 and q = Array.sub p 1 ( Array.length m ) in

  let mm = poly_real_apply_matrix q m in

   Matrix.matrix_float_scal_mult x mm ;;










(** 

Coefficients entiers


Integer coefficients

*)



(** 
 
 *)











(** 
poly_int_apply_matrix polynomial matrix
 *)


let poly_int_apply_matrix = fun (p:int array) (m:int array array) ->

 let r = Array.length m

 and d = int_of_float ( poly_int_deg p ) in

  let mm = ref ( Matrix.scal_int r r p.(d) ) in

   for i = d - 1 downto 0 do

    mm := Matrix.matrix_int_prod m !mm ;

    mm := Matrix.matrix_int_plus !mm ( Matrix.scal_int r r p.(i) ) ;

   done ;

   !mm ;;




(** 
poly_int_apply_matrix_rec polynomial matrix
 *)


let rec poly_int_apply_matrix_rec = fun (p:int array) (m:int array array) ->

 let d = int_of_float ( poly_int_deg p ) in

  if d <= 3 then poly_int_apply_matrix p m

  else

   begin

    let dd = d / 2 in

     let tail = Array.sub p 0 dd

     and head = Array.sub p dd ( d - dd + 1 )

     and mm = Matrix.int_power dd m in

      let mmm = poly_int_apply_matrix_rec head m in

       Matrix.matrix_int_plus ( poly_int_apply_matrix_rec tail m ) ( Matrix.matrix_int_prod mm mmm )

   end ;;




(** 
int_companion polynomial
 *)


let int_companion = function (p:int array) ->

 let d = int_of_float ( poly_int_deg p ) in

  let q = Array.sub p 0 d

  and coeff = (-1) / p.(d) in

   for i = 0 to d - 1 do

    q.(i) <- q.(i) * coeff

   done ;

   let m = Matrix.identity_int_bis ( d - 1 ) d in

    Array.append m [| q |] ;;






(** 
leverrier_int_char_poly matrix
 This algorithm may work
despite the use of an euclidean division.



Cet algorithme peut fonctionner malgré l'utilisation d'une division euclidienne.*)


let leverrier_int_char_poly = function (m:int array array) ->

 let l = Array.length m in

  let p = Array.make ( l + 1 ) 1

  and t = ref ( - Matrix.int_trace m ) in

   let u = ref ( Matrix.matrix_int_plus m ( Matrix.scal_int l l !t ) ) in

    p.( l - 1 ) <- !t ;

    for i = 2 to l do

     let uu = Matrix.matrix_int_prod m !u in

      t := (Matrix.int_trace uu ) / ( - i ) ;

      u := Matrix.matrix_int_plus uu ( Matrix.scal_int l l !t ) ;

      p.( l - i ) <- !t ;

    done ;

    p ;;






(** 
int_poly_det char_poly matrix
 The characteristic polynomial must be provided, 
as for example leverrier_real_char_poly m.



Le polynôme caractéristique doit être précisé, comme par exemple leverrier_real_char_poly m. *)


let int_poly_det = fun (p:int array) (m:int array array) ->

 let x = p.(0) in

  if ( Array.length m ) mod 2 = 0 then x else - x ;;






(** 
int_resultant_bis characteristic_polynomial_methode polynomial1 polynomial2
 *)


let int_resultant_bis = fun char_poly_methode (p:int array) (q:int array) ->

 let m = int_sylvester_matrix p q in

  let pp = char_poly_methode m in

   int_poly_det pp m ;;






(** 
int_discriminant_bis characteristic_polynomial_methode polynomial
 *)


let int_discriminant_bis = fun char_poly_methode (p:int array) ->

 int_resultant_bis char_poly_methode p ( poly_int_deriv p ) ;;






(** 
matrix_int_inv char_poly matrix
 The characteristic polynomial must be provided, 
as for example leverrier_real_char_poly m.



Le polynôme caractéristique doit être précisé, comme par exemple leverrier_real_char_poly m. *)


let matrix_int_inv = fun (p:int array) (m:int array array) ->

 let x = (-1) / p.(0)

 and q = Array.sub p 1 ( Array.length m ) in

  let mm = poly_int_apply_matrix q m in

   Matrix.matrix_int_scal_mult x mm ;;










(** 

Coefficients complexes


Complex coefficients

*)



(** 
 
 *)











(** 
poly_complex_apply_matrix polynomial matrix
 *)


let poly_complex_apply_matrix = fun (p:float array array array) (m:float array array) ->

 let r = ( Array.length m ) / 2

 and d = int_of_float ( poly_complex_deg p ) in

  let mm = ref ( scal_complex r r p.(d) ) in

   for i = d - 1 downto 0 do

    mm := Matrix.matrix_float_prod m !mm ;

    mm := Matrix.matrix_float_plus !mm ( scal_complex r r p.(i) ) ;

   done ;

   !mm ;;




(** 
poly_complex_apply_matrix_rec polynomial matrix
 *)


let rec poly_complex_apply_matrix_rec = fun (p:float array array array) (m:float array array) ->

 let d = int_of_float ( poly_complex_deg p ) in

  if d <= 3 then poly_complex_apply_matrix p m

  else

   begin

    let dd = d / 2 in

     let tail = Array.sub p 0 dd

     and head = Array.sub p dd ( d - dd + 1 )

     and mm = Matrix.float_power dd m in

      let mmm = poly_complex_apply_matrix_rec head m in

       Matrix.matrix_float_plus ( poly_complex_apply_matrix_rec tail m ) ( Matrix.matrix_float_prod mm mmm )

   end ;;




(** 
complex_companion polynomial
 *)


let complex_companion = function (p:float array array array) ->

 let d = int_of_float ( poly_complex_deg p ) in

  let q = Array.sub p 0 d

  and coeff = complex_inv p.(d) in

   for i = 0 to d - 1 do

    q.(i) <- Matrix.matrix_float_prod q.(i) coeff

   done ;

   let qq = Array.append q [| complex_1 |] in

    let x = real_companion ( poly_complex_real_part qq )

    and qqq = poly_complex_imag_part q in

     let y = Array.append ( Matrix.null_float ( d - 1 ) d ) [| qqq |] in


(** Attention : les coefficients du polynôme changent de signe.
Be careful: the signs of the coefficients of the polynomial change. *)


      let m = [| [| Matrix.Float_matrix_cons x ; Matrix.Float_matrix_cons y |] ;

               [| Matrix.Float_matrix_cons ( Matrix.matrix_float_opp y ) ; Matrix.Float_matrix_cons x |] |] in

      Matrix.matrix_float_demakeup ( Matrix.matrix_foa_crash ( Matrix.Foa_matrix_cons m ) ) ;;




(** 
leverrier_complex_char_poly matrix
 *)


let leverrier_complex_char_poly = function (m:float array array) ->

 let l = ( Array.length m ) / 2 in

  let p = Array.make ( l + 1 ) complex_1

  and t = ref ( Matrix.matrix_float_opp ( complex_trace m ) ) in

   let u = ref ( Matrix.matrix_float_plus m ( scal_complex l l !t ) ) in

    p.( l - 1 ) <- !t ;

    for i = 2 to l do

     let uu = Matrix.matrix_float_prod m !u in

      t := complex_div ( complex_trace uu ) ( float_to_complex ( float ( - i ) ) ) ;

      u := Matrix.matrix_float_plus uu ( scal_complex l l !t ) ;

      p.( l - i ) <- !t ;

    done ;

    p ;;






(** 
complex_poly_det char_poly matrix
 The characteristic polynomial must be provided, 
as for example leverrier_real_char_poly m.



Le polynôme caractéristique doit être précisé, comme par exemple leverrier_real_char_poly m. *)


let complex_poly_det = fun (p:float array array array) (m:float array array) ->

 let x = p.(0) in

  if ( ( Array.length m ) / 2 ) mod 2 = 0 then x else Matrix.matrix_float_opp x ;;






(** 
complex_resultant_bis characteristic_polynomial_methode polynomial1 polynomial2
 *)


let complex_resultant_bis = fun char_poly_methode (p:float array array array) (q:float array array array) ->

 let m = complex_sylvester_matrix p q in

  let pp = char_poly_methode m in

   complex_poly_det pp m ;;






(** 
complex_discriminant_bis characteristic_polynomial_methode polynomial
 *)


let complex_discriminant_bis = fun char_poly_methode (p:float array array array) ->

 complex_resultant_bis char_poly_methode p ( poly_complex_deriv p ) ;;






(** 
matrix_complex_inv char_poly matrix
 The the characteristic polynomial must be provided, 
as for example leverrier_real_char_poly m.



Le polynôme caractéristique doit être précisé, comme par exemple leverrier_real_char_poly m. *)


let matrix_complex_inv = fun (p:float array array array) (m:float array array) ->

 let x = Matrix.matrix_float_opp ( complex_inv p.(0) )

 and q = Array.sub p 1 ( ( Array.length m ) / 2 ) in

  let mm = poly_complex_apply_matrix q m in

   matrix_complex_scal_mult x mm ;;










(** 

Coefficients entiers de Gauss


Gauss integer coefficients

*)



(** 
 
 *)











(** 
poly_gauss_apply_matrix polynomial matrix
 *)


let poly_gauss_apply_matrix = fun (p:int array array array) (m:int array array) ->

 let r = Array.length m

 and d = int_of_float ( poly_gauss_deg p ) in

  let mm = ref ( scal_gauss r r p.(d) ) in

   for i = d - 1 downto 0 do

    mm := Matrix.matrix_int_prod m !mm ;

    mm := Matrix.matrix_int_plus !mm ( scal_gauss r r p.(i) ) ;

   done ;

   !mm ;;




(** 
poly_gauss_apply_matrix_rec polynomial matrix
 *)


let rec poly_gauss_apply_matrix_rec = fun (p:int array array array) (m:int array array) ->

 let d = int_of_float ( poly_gauss_deg p ) in

  if d <= 3 then poly_gauss_apply_matrix p m

  else

   begin

    let dd = d / 2 in

     let tail = Array.sub p 0 dd

     and head = Array.sub p dd ( d - dd + 1 )

     and mm = Matrix.int_power dd m in

      let mmm = poly_gauss_apply_matrix_rec head m in

       Matrix.matrix_int_plus ( poly_gauss_apply_matrix_rec tail m ) ( Matrix.matrix_int_prod mm mmm )

   end ;;




(** 
gauss_companion polynomial
 *)


let gauss_companion = function (p:int array array array) ->

 let d = int_of_float ( poly_gauss_deg p ) in

  let q = Array.sub p 0 d

  and coeff = gauss_inv p.(d) in

   for i = 0 to d - 1 do

    q.(i) <- Matrix.matrix_int_prod q.(i) coeff

   done ;

   let qq = Array.append q [| gauss_1 |] in

    let x = int_companion ( poly_gauss_real_part qq )

    and qqq = poly_gauss_imag_part q in

     let y = Array.append ( Matrix.null_int ( d - 1 ) d ) [| qqq |] in


(** Attention : les coefficients du polynôme changent de signe.
Be careful: the signs of the coefficients of the polynomial change. *)


    let m = [| [| Matrix.Int_matrix_cons x ; Matrix.Int_matrix_cons y |] ;

               [| Matrix.Int_matrix_cons ( Matrix.matrix_int_opp y ) ; Matrix.Int_matrix_cons x |] |] in

     Matrix.matrix_int_demakeup ( Matrix.matrix_ioa_crash ( Matrix.Ioa_matrix_cons m ) ) ;;




(** 
leverrier_gauss_char_poly matrix
 *)


let leverrier_gauss_char_poly = function (m:int array array) ->

 let l = ( Array.length m ) / 2 in

  let p = Array.make ( l + 1 ) gauss_1

  and t = ref ( Matrix.matrix_int_opp ( gauss_trace m ) ) in

   let u = ref ( Matrix.matrix_int_plus m ( scal_gauss l l !t ) ) in

    p.( l - 1 ) <- !t ;

    for i = 2 to l do

     let uu = Matrix.matrix_int_prod m !u in

      t := Matrix.matrix_int_scal_left_div ( - i ) ( gauss_trace uu ) ;

      u := Matrix.matrix_int_plus uu ( scal_gauss l l !t ) ;

      p.( l - i ) <- !t ;

    done ;

    p ;;






(** 
gauss_poly_det char_poly matrix
 The characteristic polynomial must be provided, 
as for example leverrier_real_char_poly m.



Le polynôme caractéristique doit être précisé, comme par exemple leverrier_real_char_poly m. *)


let gauss_poly_det = fun (p:int array array array) (m:int array array) ->

 let x = p.(0) in

  if ( ( Array.length m ) / 2 ) mod 2 = 0 then x else Matrix.matrix_int_opp x ;;






(** 
gauss_resultant_bis characteristic_polynomial_methode polynomial1 polynomial2
 *)


let gauss_resultant_bis = fun char_poly_methode (p:int array array array) (q:int array array array) ->

 let m = gauss_sylvester_matrix p q in

  let pp = char_poly_methode m in

   gauss_poly_det pp m ;;






(** 
gauss_discriminant_bis characteristic_polynomial_methode polynomial
 *)


let gauss_discriminant_bis = fun char_poly_methode (p:int array array array) ->

 gauss_resultant_bis char_poly_methode p ( poly_gauss_deriv p ) ;;






(** 
matrix_gauss_inv char_poly matrix
 The characteristic polynomial must be provided, 
as for example leverrier_real_char_poly m.



Le polynôme caractéristique doit être précisé, comme par exemple leverrier_real_char_poly m. *)


let matrix_gauss_inv = fun (p:int array array array) (m:int array array) ->

 let x = Matrix.matrix_int_opp p.(0)

 and q = Array.sub p 1 ( ( Array.length m ) / 2 ) in

  let mm = poly_gauss_apply_matrix q m in

   matrix_gauss_scal_left_div x mm ;;










(** 

Décomposition de Jordan


Jordan decomposition

*)



(** 
 
 *)











(** 
sci_jordan_decomposition_polynomial mult_rule comp_rule polynomial
 *)


let sci_jordan_decomposition_polynomial = fun mult_rule comp_rule (p:Num.num array array) ->

 let l = ( Array.length p ) - 1

 and s0 = poly_sci_x

 and i = ref 0 in

  let s = ref s0

  and s_old = ref s0 in

   let pp = poly_sci_simplify p in

    let deg_pp = poly_sci_deg pp

    and dpp = poly_sci_deriv pp in

     let max_iter = ( int_of_float ( ( log ( ( float l ) /. deg_pp ) ) /. ( log 2. ) ) ) + 1 in

      while !i <= max_iter do

       let p_p = comp_rule dpp !s in

        let z = poly_sci_bezout mult_rule p_p p in

         let u = z.(1) in

          let y = mult_rule u ( comp_rule pp !s ) in

           let x = poly_sci_cleanup ( poly_sci_minus !s ( poly_sci_mod y p ) ) in

            let w = poly_sci_mod x p in

             s_old := !s ;

             s := w ;

             if poly_sci_eq !s !s_old then i := max_int

             else ( i := !i + 1 ; s_old := !s )

      done ;

      !s ;;






(** 
sci_1024_jordan_decomposition_polynomial mult_rule comp_rule polynomial
 *)


let sci_1024_jordan_decomposition_polynomial = fun mult_rule comp_rule (p:Num.num array array) ->

 let l = ( Array.length p ) - 1

 and s0 = poly_sci_x

 and i = ref 0 in

  let s = ref s0

  and s_old = ref s0 in

   let pp = poly_sci_1024_simplify p in

    let deg_pp = poly_sci_deg pp

    and dpp = poly_sci_1024_deriv pp in

     let max_iter = ( int_of_float ( ( log ( ( float l ) /. deg_pp ) ) /. ( log 2. ) ) ) + 1 in

      while !i <= max_iter do

       let p_p = comp_rule dpp !s in

        let z = poly_sci_1024_bezout mult_rule p_p p in

         let u = z.(1) in

          let y = mult_rule u ( comp_rule pp !s ) in

           let x = poly_sci_cleanup ( poly_sci_1024_minus !s ( poly_sci_1024_mod y p ) ) in

            let w = poly_sci_1024_mod x p in

             s_old := !s ;

             s := w ;

             if poly_sci_1024_eq !s !s_old then i := max_int

             else ( i := !i + 1 ; s_old := !s )

      done ;

      !s ;;






(** 
lento_complex_jordan_decomposition_polynomial sci_mult_rule sci_comp_rule polynomial
 *)


let lento_complex_jordan_decomposition_polynomial = fun sci_mult_rule sci_comp_rule (p:float array array array) ->

 poly_sci_to_complex ( sci_jordan_decomposition_polynomial sci_mult_rule sci_comp_rule ( poly_complex_to_sci p ) ) ;;






(** 
lento_real_jordan_decomposition_polynomial sci_mult_rule sci_comp_rule polynomial
 *)


let lento_real_jordan_decomposition_polynomial = fun sci_mult_rule sci_comp_rule (p:float array) ->

 poly_sci_real_part ( sci_jordan_decomposition_polynomial sci_mult_rule sci_comp_rule ( poly_real_to_sci p ) ) ;;






(** 
largo_complex_jordan_decomposition_polynomial sci_mult_rule sci_comp_rule polynomial
 *)


let largo_complex_jordan_decomposition_polynomial = fun sci_1024_mult_rule sci_1024_comp_rule (p:float array array array) ->

 poly_sci_to_complex ( sci_1024_jordan_decomposition_polynomial sci_1024_mult_rule sci_1024_comp_rule ( poly_complex_to_sci p ) ) ;;






(** 
largo_real_jordan_decomposition_polynomial sci_mult_rule sci_comp_rule polynomial
 *)


let largo_real_jordan_decomposition_polynomial = fun sci_1024_mult_rule sci_1024_comp_rule (p:float array) ->

 poly_sci_real_part ( sci_1024_jordan_decomposition_polynomial sci_1024_mult_rule sci_1024_comp_rule ( poly_real_to_sci p ) ) ;;






(** 
real_jordan_decomposition_polynomial mult_rule comp_rule polynomial
 *)


let real_jordan_decomposition_polynomial = fun mult_rule comp_rule (p:float array) ->

 let l = ( Array.length p ) - 1

 and seuil = 128. *. epsilon_float

 and s0 = poly_real_x

 and i = ref 0 in

  let s = ref s0

  and s_old = ref s0 in

   let pp = poly_real_simplify p in

    let deg_pp = poly_real_deg pp

    and dpp = poly_real_deriv pp in

     let max_iter = ( int_of_float ( ( log ( ( float l ) /. deg_pp ) ) /. ( log 2. ) ) ) + 1 in

      while !i <= max_iter do

       let p_p = comp_rule dpp !s in

        let z = poly_real_bezout mult_rule p_p p in

         let u = z.(1) in

          let y = mult_rule u ( comp_rule pp !s ) in

           let x = poly_real_cleanup ( poly_real_minus !s ( poly_real_mod y p ) ) in

            let w = poly_real_mod x p in

             s_old := !s ;

             s := w ;

             if Matrix.vector_float_norm_inf ( poly_real_minus !s !s_old ) <= seuil *. ( Matrix.vector_float_norm_1 !s_old ) then i := max_int

             else ( i := !i + 1 ; s_old := !s )

      done ;

      !s ;;






(** 
complex_jordan_decomposition_polynomial mult_rule comp_rule polynomial
 The computing time seems to be
in O(n^4) where n is the order of the matrix when there is no iteration.
When the order is too big, the calculus is erroneous.
The characteristic polynomial must be provided, as for example leverrier_real_char_poly m.



La méthode de calcul du polynôme caractéristique doit être précisé, comme par exemple leverrier_real_char_poly m.
Il semble que le temps de calcul soit en O(n^4) où n est l'ordre de la matrice
quand il n' y a pas d'itération. Quand l'ordre est trop grand, le calcul est erroné. *)


let complex_jordan_decomposition_polynomial = fun mult_rule comp_rule (p:float array array array) ->

 let l = ( Array.length p ) - 1

 and seuil = 128. *. epsilon_float

 and s0 = poly_complex_x

 and i = ref 0 in

  let s = ref s0

  and s_old = ref s0 in

   let pp = poly_complex_simplify p in

    let deg_pp = poly_complex_deg pp

    and dpp = poly_complex_deriv pp in

     let max_iter = ( int_of_float ( ( log ( ( float l ) /. deg_pp ) ) /. ( log 2. ) ) ) + 1 in

      while !i <= max_iter do

       let p_p = comp_rule dpp !s in

        let z = poly_complex_bezout mult_rule p_p p in

         let u = z.(1) in

          let y = mult_rule u ( comp_rule pp !s ) in

           let x = poly_complex_cleanup ( poly_complex_minus !s ( poly_complex_mod y p ) ) in

            let w = poly_complex_mod x p in

             s_old := !s ;

             s := w ;

             if vector_complex_norm_inf_bis ( poly_complex_minus !s !s_old ) <= seuil *. ( vector_complex_norm_1_bis !s_old ) then i := max_int

             else ( i := !i + 1 ; s_old := !s )

      done ;

      !s ;;






(** 
jordan_decomposition apply_rule polynomial matrix
 The (real or complex) decomposition polynomial of the matrix must be provided, 
using for example the function lento_complex_jordan_decomposition_polynomial.
The rule of application of a polynomial to a matrix must be provided too.



Le polynôme de décomposition (réel ou complexe) de la matrice doit être précisé, 
en utilisant par exemple la fonction lento_complex_jordan_decomposition_polynomial.
La loi d'application d'un polynôme à une matrice doit aussi être précisée. *)


let jordan_decomposition = fun apply_rule p (m:float array array) ->

 let d = apply_rule p m in

  let n = Matrix.matrix_float_minus m d in

   [| d ; n |] ;;










(** 
§ 
 *)



(** 

Autres constructions


Further constructions

*)



(** 
 
 *)











(** 

Coefficients du binôme et accélérateurs de convergence


Binoùmila coefficients and convergence accelerators

*)



(** 
 
 *)











(** 
newton_float_binom_coeff mult_rule integer
 *)


let newton_float_binom_coeff = fun mult_rule (n:int) ->

 poly_real_pow mult_rule n [| 1. ; 1. |] ;;




(** 
alternate_newton_float_binom_coeff mult_rule integer
 *)


let alternate_newton_float_binom_coeff = fun mult_rule (n:int) ->

 poly_real_pow mult_rule n [| 1. ; -1. |] ;;




(** 
newton_int_binom_coeff mult_rule integer
 *)


let newton_int_binom_coeff = fun mult_rule (n:int) ->

 poly_int_pow mult_rule n [| 1 ; 1 |] ;;




(** 
alternate_newton_int_binom_coeff mult_rule integer
 *)


let alternate_newton_int_binom_coeff = fun mult_rule (n:int) ->

 poly_int_pow mult_rule n [| 1 ; -1 |] ;;




(** 
newton_complex_binom_coeff mult_rule integer
 *)


let newton_complex_binom_coeff = fun mult_rule (n:int) ->

 poly_complex_pow mult_rule n [| complex_1 ; complex_1 |] ;;




(** 
alternate_newton_complex_binom_coeff mult_rule integer
 *)


let alternate_newton_complex_binom_coeff = fun mult_rule (n:int) ->

 poly_complex_pow mult_rule n [| complex_1 ; complex_minus_1 |] ;;




(** 
newton_gauss_binom_coeff mult_rule integer
 *)


let newton_gauss_binom_coeff = fun mult_rule (n:int) ->

 poly_gauss_pow mult_rule n [| gauss_1 ; gauss_1 |] ;;




(** 
alternate_newton_gauss_binom_coeff mult_rule integer
 *)


let alternate_newton_gauss_binom_coeff = fun mult_rule (n:int) ->

 poly_gauss_pow mult_rule n [| gauss_1 ; gauss_minus_1 |] ;;




(** 
newton_sci_binom_coeff mult_rule integer
 *)


let newton_sci_binom_coeff = fun mult_rule (n:int) ->

 poly_sci_pow mult_rule n [| Sci.sci_1 ; Sci.sci_1 |] ;;




(** 
alternate_newton_sci_binom_coeff mult_rule integer
 *)


let alternate_newton_sci_binom_coeff = fun mult_rule (n:int) ->

 poly_sci_pow mult_rule n [| Sci.sci_1 ; Sci.sci_minus_1 |] ;;






(** 
float_euler_transform mult_rule index sequence
 *)


let float_euler_transform = fun mult_rule (n:int) (seq:float array) ->

 if n = 0 then seq.(0) *. 0.5

 else

  begin

   let v = newton_float_binom_coeff mult_rule n

   and s = Array.sub seq 0 ( succ n ) in

    ( (2.) ** ( float ( - ( succ n ) ) ) ) *. ( Matrix.vector_float_scal_prod v s )

  end ;;




(** 
float_differences sequence
 *)


let float_differences = function (seq:float array) ->

 let length = pred ( Array.length seq ) in

  let s = Array.mapi ( fun i x -> x -. seq.(i) ) ( Array.sub seq 1 length ) in

   Array.append [| seq.(0) |] s ;;




(** 
float_euler_sum_series mult_rule sequence
 *)


let float_euler_sum_series = fun mult_rule (seq:float array) ->

 let accu = ref 0. in

  for i = 0 to ( Array.length seq ) - 1 do

   accu := !accu +. ( float_euler_transform mult_rule i seq ) ;

  done ;

  !accu ;;




(** 
float_euler_sum_sequence mult_rule sequence
 *)


let float_euler_sum_sequence = fun mult_rule (seq:float array) ->

 let s = float_differences seq in

  float_euler_sum_series mult_rule s ;;




(** 
complex_euler_transform mult_rule index sequence
 *)


let complex_euler_transform = fun mult_rule (n:int) (seq:float array array array) ->

 if n = 0 then Matrix.matrix_float_scal_mult 0.5 seq.(0)

 else

  begin

   let v = complex_poly_to_complex_double_vector ( newton_complex_binom_coeff mult_rule n )

   and s = complex_poly_to_complex_double_vector ( Array.sub seq 0 ( succ n ) ) in

    Matrix.matrix_float_scal_mult ( (2.) ** ( float ( - ( succ n ) ) ) ) ( vector_complex_hermitian_prod v s )

  end ;;




(** 
complex_differences sequence
 *)


let complex_differences = function (seq:float array array array) ->

 let length = pred ( Array.length seq ) in

  let s = Array.mapi ( fun i x -> Matrix.matrix_float_minus x seq.(i) ) ( Array.sub seq 1 length ) in

   Array.append [| seq.(0) |] s ;;




(** 
complex_euler_sum_series mult_rule sequence
 *)


let complex_euler_sum_series = fun mult_rule (seq:float array array array) ->

 let accu = ref complex_0 in

  for i = 0 to ( Array.length seq ) - 1 do

   accu := Matrix.matrix_float_plus !accu ( complex_euler_transform mult_rule i seq ) ;

  done ;

  !accu ;;




(** 
complex_euler_sum_sequence mult_rule sequence
 *)


let complex_euler_sum_sequence = fun mult_rule (seq:float array array array) ->

 let s = complex_differences seq in

  complex_euler_sum_series mult_rule s ;;










(** 

Générateurs aléatoires


Random generators

*)



(** 
 
 *)











(** 
matrix_complex_random rows columns range
 *)


let matrix_complex_random = fun (r:int) (c:int) (w:float) ->

 let x = Matrix.matrix_float_bal_random r c w

 and y = Matrix.matrix_float_bal_random r c w in

  matrix_complexify x y ;;




(** 
complex_random range
 *)


let complex_random = function(x:float) ->

 matrix_complex_random 1 1 x ;;




(** 
poly_complex_random degree range
 *)


let poly_complex_random = fun (d:int) (x:float) ->

 let v = Matrix.vector_float_bal_random ( 2 * ( d + 1 ) ) x in

  complex_vector_to_complex_poly v ;;




(** 
poly_complex_unitary_random degree range
 *)


let poly_complex_unitary_random = fun (d:int) (x:float) ->

 let p = poly_complex_random ( pred d ) x in

  Array.append p [| complex_1 |] ;;




(** 
matrix_complex_herm_random order range
 *)


let matrix_complex_herm_random = fun (r:int) (x:float) ->

 let s = Matrix.sym_float_bal_random r x

 and a = Matrix.antisym_float_bal_random r x in

  matrix_complexify s a ;;




(** 
matrix_complex_anti_herm_random order range
 *)


let matrix_complex_anti_herm_random = fun (r:int) (x:float) ->

 let s = Matrix.sym_float_bal_random r x

 and a = Matrix.antisym_float_bal_random r x in

  matrix_complexify a s ;;




(** 
matrix_unitary_random order range
 *)


let matrix_unitary_random = fun (r:int) (x:float) ->

 let a = matrix_complex_anti_herm_random r x in

  Matrix.generic_ortho_float_antisym a ;;






(** 
matrix_gauss_random rows columns range
 *)


let matrix_gauss_random = fun (r:int) (c:int) (w:int) ->

 let x = Matrix.matrix_int_bal_random r c w

 and y = Matrix.matrix_int_bal_random r c w in

  matrix_gauss_complexify x y ;;




(** 
gauss_random range
 *)


let gauss_random = function(x:int) ->

 matrix_gauss_random 1 1 x ;;




(** 
poly_gauss_random degree range
 *)


let poly_gauss_random = fun (d:int) (x:int) ->

 let v = Matrix.vector_int_bal_random ( 2 * ( d + 1 ) ) x in

  gauss_vector_to_gauss_poly v ;;




(** 
poly_gauss_unitary_random degree range
 *)


let poly_gauss_unitary_random = fun (d:int) (x:int) ->

 let p = poly_gauss_random ( pred d ) x in

  Array.append p [| gauss_1 |] ;;




(** 
matrix_gauss_herm_random order range
 *)


let matrix_gauss_herm_random = fun (r:int) (x:int) ->

 let s = Matrix.sym_int_bal_random r x

 and a = Matrix.antisym_int_bal_random r x in

  matrix_gauss_complexify s a ;;




(** 
matrix_gauss_anti_herm_random order range
 *)


let matrix_gauss_anti_herm_random = fun (r:int) (x:int) ->

 let s = Matrix.sym_int_bal_random r x

 and a = Matrix.antisym_int_bal_random r x in

  matrix_gauss_complexify a s ;;










(** 
§ 
 *)



(** 

Réduction des matrices et racines des polynômes


Reduction of matrices and roots of polynomials

*)



(** 
 
 *)











(** 
complex_diago_spectrum diagonalization_methode matrix
 *)


let complex_diago_spectrum = fun (diagonalization_methode:float array array -> float array array array array) (m:float array array) ->

 let w = diagonalization_methode m in

  w.(0) ;;






(** 
complex_householder_step threshold index matrix
 Output: transformation matrix, coefficient.



Sortie : matrice de transformation, coefficient. *)


let complex_householder_step = fun (threshold:float) (i:int) (m:float array array) ->

 let x = matrix_complex_extract_column_to_matrix_trans i m

 and coeff = matrix_complex_extract_coefficient i i m

 and r = Array.length m

 and c = Array.length m.(0) in

  let rr = r / 2

  and xx = Matrix.matrix_float_copy x

  and argument = apply_built_in_complex_float_to_matrix Complex.arg coeff in

   let first_row = xx.(0)

   and second_row = xx.(1) in

    for j = 0 to i - 1 do

     let jj = rr + j in

      first_row.(j) <- 0. ;

      first_row.(jj) <- 0. ;

      second_row.(j) <- 0. ;

      second_row.(jj) <- 0. ;

    done ;

    let norm = Matrix.vector_float_norm_2 xx.(0) in

     if norm <= threshold then [| Matrix.identity_float r c ; complex_0 |]

     else

      begin

       let u = Matrix.matrix_float_copy xx

       and ii = i + rr in

        let alpha = Matrix.matrix_float_scal_mult ( -. norm ) ( polar_to_matrix 1. argument )

        and fr = u.(0)

        and sr = u.(1) in

         let a00 = 0.5 *. ( alpha.(0).(0) +. alpha.(1).(1) )

         and b01 = 0.5 *. ( alpha.(0).(1) -. alpha.(1).(0) )

         and c10 = 0.5 *. ( alpha.(1).(0) -. alpha.(0).(1) )

         and d11 = 0.5 *. ( alpha.(1).(1) +. alpha.(0).(0) ) in

          fr.(i) <- fr.(i) +. a00 ;

          fr.(ii) <- fr.(ii) +. b01 ;

          sr.(i) <- sr.(i) +. c10 ;

          sr.(ii) <- sr.(ii) +. d11 ;

          let length = Matrix.vector_float_norm_2 fr in

           let v = Matrix.matrix_float_scal_left_div length u in

            let w1 = vector_complex_hermitian_prod v x

            and w2 = vector_complex_hermitian_prod x v

            and vv = Matrix.float_transpose v in

             let w = ( if complex_module w2 <> 0. then Matrix.matrix_float_prod w1 ( complex_inv w2 ) else complex_0 ) in

              w.(0).(0) <- w.(0).(0) +. 1. ;

              w.(1).(1) <- w.(1).(1) +. 1. ;

              let ww = matrix_complex_scal_mult w ( Matrix.matrix_float_twisted_prod vv vv ) in

               let q = Matrix.matrix_float_minus ( Matrix.identity_float r c ) ww in

                [| q ; alpha |] ;

      end ;;






(** 
complex_qr_decomposition threshold matrix
 Output: unitary transformation matrix q and complex upper triangular matrix r such that m = qr, transposed transformation matrix.



Sortie : matrice de transformation unitaire q, matrice triangulaire supérieure complexe r telles que m = qr, transposée de la matrice de transformation. *)


let complex_qr_decomposition = fun (threshold:float) (m:float array array) ->

 let r = Array.length m

 and c = Array.length m.(0) in

  let n = ( min r c ) / 2

  and qq = ref ( Matrix.identity_float r c )

  and rr = ref ( Matrix.matrix_float_copy m ) in

   for i = 0 to n - 2 do

    let result = complex_householder_step threshold i !rr in

     rr := Matrix.matrix_float_prod result.(0) !rr ;

     qq := Matrix.matrix_float_prod result.(0) !qq ;

   done ;

   [| Matrix.float_transpose !qq ; !rr ; !qq |] ;;






(** 
complex_francis_iteration threshold_qr threshold max_steps threshold matrix
 Output: candidate for the upper trigonality, 
unitary transformation matrix q, transposed transformation matrix, measure of the under diagonal part.



Sortie : candidat pour la trigonalité supérieure, matrice de transformation unitaire q, transposée de la matrice de transformation, mesure de la partie sous-diagonale. *)


let complex_francis_iteration = fun (threshold_qr:float) (threshold:float) (steps:int) (m:float array array) ->

 let r = Array.length m

 and c = Array.length m.(0)

 and res = complex_qr_decomposition threshold_qr m in

  let n = ( min r c ) / 2 - 1

  and q = ref res.(0)

  and qq = ref res.(2)

  and i = ref 0

  and error = ref threshold in

   let candidate = ref ( Matrix.matrix_float_prod res.(1) !q ) in

    while ( !i <= steps ) && ( !error >= threshold ) do

     let result = complex_qr_decomposition threshold_qr !candidate in

      candidate := Matrix.matrix_float_prod result.(1) result.(0) ;

      qq := Matrix.matrix_float_prod result.(2) !qq ;

      q := Matrix.matrix_float_prod !q result.(0) ;

      i := !i + 1 ;

      error := 0. ;

      for j = 1 to n do

       let row = matrix_complex_extract_row_to_poly j !candidate in

        error := !error +. ( vector_complex_norm_2 ( Array.sub row 0 j ) ) ;

      done ;

    done ;

    [| !candidate ; !q ; !qq ; [|[| !error |]|] |] ;;






(** 
complex_francis_shifted_step threshold shift matrix
 Output: candidate for the tridiagonality, 
left unitary transformation matrix, transpose of the transformation matrix. *)


let complex_francis_shifted_step = fun (threshold:float) (shift:float array array) (m:float array array) ->

 let r = Array.length m in

  let nn = r / 2 in

   let sc = scal_complex nn nn shift in

    let mm = Matrix.matrix_float_minus m sc in

     let result = complex_qr_decomposition threshold mm in

      let product = Matrix.matrix_float_prod result.(1) result.(0) in

       [| Matrix.matrix_float_plus sc product ; result.(0) ; result.(2) |] ;;






(** 
complex_francis_shifted_iteration threshold_qr threshold max_steps shift matrix
 Output: candidate for the upper trigonality, 
unitary transformation matrix q, transposed transformation matrix, measure of the under diagonal part.



Sortie : candidat pour la trigonalité supérieure, matrice de transformation unitaire q, transposée de la matrice de transformation, mesure de la partie sous-diagonale. *)


let complex_francis_shifted_iteration = fun (threshold_qr:float) (threshold:float) (steps:int) (shift:float array array) (m:float array array) ->

 let res = ref ( complex_francis_shifted_step threshold_qr shift m )

 and r = Array.length m

 and error = ref threshold in

  let n = r / 2 - 1

  and candidate = ref !res.(0)

  and q = ref !res.(1)

  and qq = ref !res.(2)

  and i = ref 0 in

   while ( !i <= steps ) && ( !error >= threshold ) do

    let result = complex_francis_shifted_step threshold_qr shift !candidate in

     candidate := result.(0) ;

     qq := Matrix.matrix_float_prod result.(2) !qq ;

     q := Matrix.matrix_float_prod !q result.(1) ;

     i := !i + 1 ;

     error := 0. ;

     for j = 1 to n do

      let row = matrix_complex_extract_row_to_poly j !candidate in

      error := !error +. ( vector_complex_norm_2 ( Array.sub row 0 j ) ) ;

     done ;

    done ;

    [| !candidate ; !q ; !qq ; [|[| !error |]|] |] ;;






(** 
complex_francis_schur_decomposition threshold_qr threshold max_steps matrix
 Output: candidate for the upper trigonality, 
unitary transformation matrix q, transposed transformation matrix, measure of the under diagonal part.



Sortie : candidat pour la trigonalité supérieure, matrice de transformation unitaire q, transposée de la matrice de transformation, mesure de la partie sous-diagonale. *)


let complex_francis_schur_decomposition = fun (threshold_qr:float) (threshold:float) (steps:int) (m:float array array) ->

 let old_res = ref ( complex_francis_iteration threshold_qr threshold 0 m )

 and i = ref 2 in

  let res = ref ( complex_francis_iteration threshold_qr threshold 0 !old_res.(0) )

  and old_q = ref !old_res.(1)

  and old_qq = ref !old_res.(2) in

   let q = ref ( Matrix.matrix_float_prod !old_q !res.(1) )

   and qq = ref ( Matrix.matrix_float_prod !res.(2) !old_qq ) in

    while ( !res.(3).(0).(0) < !old_res.(3).(0).(0) ) && ( !i <= steps ) do

     old_res := !res ;

     res := complex_francis_iteration threshold_qr threshold 0 !old_res.(0) ;

     old_q := !q ;

     old_qq := !qq ;

     q := Matrix.matrix_float_prod !old_q !res.(1) ;

     qq := Matrix.matrix_float_prod !res.(2) !old_qq ;

     i := !i + 1 ;

    done ;

    if !res.(3).(0).(0) < !old_res.(3).(0).(0) then

     [| !res.(0) ; !q ; !qq ; !res.(3) |]

    else [| !old_res.(0) ; !old_q ; !old_qq ; !old_res.(3) |] ;;






(** 
complex_shifted_francis_schur_decomposition threshold_qr threshold max_steps shift matrix
 Output: candidate for the upper trigonality, 
unitary transformation matrix q, transposed transformation matrix, measure of the under diagonal part.



Sortie : candidat pour la trigonalité supérieure, matrice de transformation unitaire q, transposée de la matrice de transformation, mesure de la partie sous-diagonale. *)


let complex_shifted_francis_schur_decomposition = fun (threshold_qr:float) (threshold:float) (steps:int) (shift:float array array) (m:float array array) ->

 let old_res = ref ( complex_francis_shifted_iteration threshold_qr threshold 0 shift m )

 and i = ref 2 in

  let res = ref ( complex_francis_shifted_iteration threshold_qr threshold 0 shift !old_res.(0) )

  and old_q = ref !old_res.(1)

  and old_qq = ref !old_res.(2) in

   let q = ref ( Matrix.matrix_float_prod !old_q !res.(1) )

   and qq = ref ( Matrix.matrix_float_prod !res.(2) !old_qq ) in

    while ( !res.(3).(0).(0) < !old_res.(3).(0).(0) ) && ( !i <= steps ) do

     old_res := !res ;

     res := complex_francis_shifted_iteration threshold_qr threshold 0 shift !old_res.(0) ;

     old_q := !q ;

     old_qq := !qq ;

     q := Matrix.matrix_float_prod !old_q !res.(1) ;

     qq := Matrix.matrix_float_prod !res.(2) !old_qq ;

     i := !i + 1 ;

    done ;

    if !res.(3).(0).(0) < !old_res.(3).(0).(0) then

     [| !res.(0) ; !q ; !qq ; !res.(3) |]

    else [| !old_res.(0) ; !old_q ; !old_qq ; !old_res.(3) |] ;;






(** 
complex_francis_spectrum threshold_qr threshold max_steps matrix
 *)


let complex_francis_spectrum = fun (threshold_qr:float) (threshold:float) (steps:int) (m:float array array) ->

 let r = ( Array.length m ) / 2 in

  let u = matrix_unitary_random r 1. in

   let v = Matrix.matrix_float_twisted_prod u m in

    let w = Matrix.matrix_float_twisted_prod u v in

     let old_res = ref ( complex_francis_iteration threshold_qr threshold 1 w )

     and i = ref 2 in

      let res = ref ( complex_francis_iteration threshold_qr threshold 1 !old_res.(0) ) in

       while ( !res.(3).(0).(0) < !old_res.(3).(0).(0) ) && ( !i < steps ) do

        old_res := !res ;

        res := complex_francis_iteration threshold_qr threshold 1 !old_res.(0) ;

        i := !i + 1 ;

       done ;

       if !res.(3).(0).(0) < !old_res.(3).(0).(0) then

        matrix_complex_extract_diag_to_poly !res.(0)

       else matrix_complex_extract_diag_to_poly !old_res.(0) ;;






(** 
complex_shifted_francis_spectrum threshold_qr threshold max_steps shift matrix
 *)


let complex_shifted_francis_spectrum = fun (threshold_qr:float) (threshold:float) (steps:int) (shift:float array array) (m:float array array) ->

 let r = ( Array.length m ) / 2 in

  let u = matrix_unitary_random r 1. in

   let v = Matrix.matrix_float_twisted_prod u m in

    let w = Matrix.matrix_float_twisted_prod u v in

     let old_res = ref ( complex_francis_shifted_iteration threshold_qr threshold 1 shift w )

     and i = ref 2 in

      let res = ref ( complex_francis_shifted_iteration threshold_qr threshold 1 shift !old_res.(0) ) in

       while ( !res.(3).(0).(0) < !old_res.(3).(0).(0) ) && ( !i < steps ) do

        old_res := !res ;

        res := complex_francis_shifted_iteration threshold_qr threshold 1 shift !old_res.(0) ;

        i := !i + 1 ;

       done ;

       if !res.(3).(0).(0) < !old_res.(3).(0).(0) then

        matrix_complex_extract_diag_to_poly !res.(0)

       else matrix_complex_extract_diag_to_poly !old_res.(0) ;;






(** 
complex_francis_spectrum_seq threshold_qr threshold max_steps matrix
 *)


let complex_francis_spectrum_seq = fun (threshold_qr:float) (threshold:float) (steps:int) (m:float array array) ->

 let r = ( Array.length m ) / 2 in

  let u = matrix_unitary_random r 1. in

   let v = Matrix.matrix_float_twisted_prod u m in

    let w = Matrix.matrix_float_twisted_prod u v in

     let old_res = ref ( complex_francis_iteration threshold_qr threshold 1 w )

     and i = ref 1 in

      let res = ref ( complex_francis_iteration threshold_qr threshold 1 !old_res.(0) ) in

       let seq = ref [| complex_poly_to_complex_vector ( matrix_complex_extract_diag_to_poly !old_res.(0) ) ;

        complex_poly_to_complex_vector ( matrix_complex_extract_diag_to_poly !res.(0) ) |] in

        while ( !res.(3).(0).(0) < !old_res.(3).(0).(0) ) && ( !i < pred steps ) do

         old_res := !res ;

         res := complex_francis_iteration threshold_qr threshold 1 !old_res.(0) ;

         seq := Array.append !seq [| complex_poly_to_complex_vector ( matrix_complex_extract_diag_to_poly !res.(0) ) |] ;

         i := !i + 1 ;

        done ;

        if !res.(3).(0).(0) >= !old_res.(3).(0).(0) then

         seq := Array.sub !seq 0 ( pred ( Array.length !seq ) ) ;

        !seq ;;






(** 
complex_shifted_francis_spectrum_seq threshold_qr threshold max_steps shift matrix
 *)


let complex_shifted_francis_spectrum_seq = fun (threshold_qr:float) (threshold:float) (steps:int) (shift:float array array) (m:float array array) ->

 let r = ( Array.length m ) / 2 in

  let u = matrix_unitary_random r 1. in

   let v = Matrix.matrix_float_twisted_prod u m in

    let w = Matrix.matrix_float_twisted_prod u v in

     let old_res = ref ( complex_francis_shifted_iteration threshold_qr threshold 1 shift w )

     and i = ref 1 in

      let res = ref ( complex_francis_shifted_iteration threshold_qr threshold 1 shift !old_res.(0) ) in

       let seq = ref [| complex_poly_to_complex_vector ( matrix_complex_extract_diag_to_poly !old_res.(0) ) ;

        complex_poly_to_complex_vector ( matrix_complex_extract_diag_to_poly !res.(0) ) |] in

        while ( !res.(3).(0).(0) < !old_res.(3).(0).(0) ) && ( !i < pred steps ) do

         old_res := !res ;

         res := complex_francis_shifted_iteration threshold_qr threshold 1 shift !old_res.(0) ;

         seq := Array.append !seq [| complex_poly_to_complex_vector ( matrix_complex_extract_diag_to_poly !res.(0) ) |] ;

         i := !i + 1 ;

        done ;

        if !res.(3).(0).(0) >= !old_res.(3).(0).(0) then

         seq := Array.sub !seq 0 ( pred ( Array.length !seq ) ) ;

        !seq ;;






(** 
complex_compensated_francis_spectrum accelerator threshold_qr threshold max_steps matrix
 A convergence accelerator for real vector sequences
must be provided, like for instance Matrix.vector_float_approx_bis.



Il faut fournir un accélérateur de convergence de suites de vecteurs réels, comme par exemple Matrix.vector_float_approx_bis. *)


let complex_compensated_francis_spectrum = fun accel (threshold_qr:float) (threshold:float) (steps:int) (m:float array array) ->

 let s = complex_francis_spectrum_seq threshold_qr threshold steps m in

  let limit = accel s in

   complex_vector_to_complex_poly limit ;;






(** 
complex_compensated_shifted_francis_spectrum accelerator threshold_qr threshold max_steps shift matrix
 A convergence accelerator for real vector sequences
must be provided, like for instance Matrix.vector_float_approx_bis.



Il faut fournir un accélérateur de convergence de suites de vecteurs réels, comme par exemple Matrix.vector_float_approx_bis. *)


let complex_compensated_shifted_francis_spectrum = fun accel (threshold_qr:float) (threshold:float) (steps:int) (shift:float array array) (m:float array array) ->

 let s = complex_shifted_francis_spectrum_seq threshold_qr threshold steps shift m in

  let limit = accel s in

   complex_vector_to_complex_poly limit ;;






(** 
direct_complex_diagonalization methode_ker threshold_qr threshold steps_qr steps_power matrix
 The matrix is supposed to be diagonalizable.
The first number of steps steps_qr is the one used in
the QR algorithm of Francis ; the second steps is the one used in the inverse iteration.
The method methode_ker may be the one used to search for a kernel with the singular value decomposition.
In the case when the matrix is not simple, the passage matrix has few precision.
Output: spectrum, matrix whose columns are the respective eigenvectors, matrix whose rows are the respective eigenvectors.



Sortie : spectre, matrice dont les colonnes sont les vecteurs propres correspondants, matrice dont les lignes sont les vecteurs propores correspondants.
La matrice est supposée diagonalisable.
Le premier nombre maximal de pas steps_qr est celui utilisé pour l'algorithme QR de Francis ;
le deuxième steps est celui utilisé dans l'itération inverse.
La méthode methode_ker peut être celle utilisée pour rechercher un noyau avec la décomposition en valeurs singulières.
Dans le cas où la matrice n'est pas simple, la matrice de passage est peu précise. *)


let direct_complex_diagonalization = fun methode_ker (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (m:float array array) ->

 let res = complex_francis_schur_decomposition threshold_qr threshold steps_qr m

 and seuil = sqrt epsilon_float

 and nn = Array.length m

 and accu_integer = ref 0

 and accu_complex = ref complex_0 in

  let p = Array.map clean_complex ( matrix_complex_extract_diag_to_poly res.(0) )

  and q = Matrix.float_transpose res.(1)

  and n = nn / 2 in

   let spectrum = Array.make n complex_0

   and n_n = n - 1

   and trans_passage = Array.make_matrix nn nn 0. in

    for i = 0 to n_n do

     let candidate_value = p.(i) in

      let difference = Matrix.matrix_float_minus m ( scal_complex n n candidate_value ) in

       let test = Matrix.float_invertibility difference in

        if test then

         begin

          let mm = Matrix.clean_inv difference in

           let w = Matrix.float_normalized_iterate Matrix.vector_float_norm_2 steps mm q.(i) in

            trans_passage.(i) <- Matrix.vector_float_copy w ;

            trans_passage.( n + i ) <- vector_complex_i_times w ;

            let ww = Matrix.matrix_vector_float_prod mm w

            and z = complex_vector_to_complex_poly w in

             let zz = complex_vector_to_complex_poly ww in

              for j = 0 to n_n do

               let divisor = z.(j) in

                if complex_module divisor > seuil then

                 begin

                  accu_complex := Matrix.matrix_float_plus !accu_complex ( Matrix.matrix_float_prod zz.(j) ( complex_inv divisor ) ) ;

                  accu_integer := succ !accu_integer ;

                 end ;

              done ;

              let coeff = clean_complex ( Matrix.matrix_float_scal_left_div ( float !accu_integer ) !accu_complex ) in

               accu_complex := complex_0 ;

               accu_integer := 0 ;

               spectrum.(i) <- Matrix.matrix_float_plus candidate_value ( complex_inv coeff ) ;

         end

        else

         begin

          spectrum.(i) <- candidate_value ;

          let k = methode_ker difference in

           let kk = Array.length k in

            let v = Matrix.vector_float_bal_random kk 10. in

             let w_w = ( Matrix.matrix_vector_float_prod ( Matrix.float_transpose k ) ( Matrix.vector_float_scal_mult ( 1. /. ( Matrix.vector_float_norm_2 v ) ) v ) ) in

              let w_coeff = 1. /. ( Matrix.vector_float_norm_2 w_w ) in

               let w = Matrix.vector_float_scal_mult w_coeff w_w in

                trans_passage.(i) <- Matrix.vector_float_copy w ;

                trans_passage.( n + i ) <- vector_complex_i_times w ;

         end ;

    done ;

    [| spectrum ; [| Matrix.float_transpose trans_passage |] ; [| trans_passage  |] |] ;; 






(** 
direct_complex_shifted_diagonalization methode_ker threshold_qr threshold steps_qr steps_power shift matrix
 The matrix is supposed to be diagonalizable.
The first number of steps steps_qr is the one used in
the QR algorithm of Francis ; the second steps is the one used in the inverse iteration.
The method methode_ker may be the one used to search for a kernel with the singular value decomposition.
In the case when the matrix is not simple, the passage matrix has few precision.
Output: spectrum, matrix whose columns are the respective eigenvectors, matrix whose rows are the respective eigenvectors.



Sortie : spectre, matrice dont les colonnes sont les vecteurs propres correspondants, matrice dont les lignes sont les vecteurs propores correspondants.
La matrice est supposée diagonalisable.
Le premier nombre maximal de pas steps_qr est celui utilisé pour l'algorithme QR de Francis ;
le deuxième steps est celui utilisé dans l'itération inverse.
La méthode methode_ker peut être celle utilisée pour rechercher un noyau avec la décomposition en valeurs singulières.
Dans le cas où la matrice n'est pas simple, la matrice de passage est peu précise. *)


let direct_complex_shifted_diagonalization = fun methode_ker (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (shift:float array array) (m:float array array) ->

 let res = complex_shifted_francis_schur_decomposition threshold_qr threshold steps_qr shift m

 and seuil = sqrt epsilon_float

 and nn = Array.length m

 and accu_integer = ref 0

 and accu_complex = ref complex_0 in

  let p = Array.map clean_complex ( matrix_complex_extract_diag_to_poly res.(0) )

  and q = Matrix.float_transpose res.(1)

  and n = nn / 2 in

   let spectrum = Array.make n complex_0

   and n_n = n - 1

   and trans_passage = Array.make_matrix nn nn 0. in

    for i = 0 to n_n do

     let candidate_value = p.(i) in

      let difference = Matrix.matrix_float_minus m ( scal_complex n n candidate_value ) in

       let test = Matrix.float_invertibility difference in

        if test then

         begin

          let mm = Matrix.clean_inv difference in

           let w = Matrix.float_normalized_iterate Matrix.vector_float_norm_2 steps mm q.(i) in

            trans_passage.(i) <- Matrix.vector_float_copy w ;

            trans_passage.( n + i ) <- vector_complex_i_times w ;

            let ww = Matrix.matrix_vector_float_prod mm w

            and z = complex_vector_to_complex_poly w in

             let zz = complex_vector_to_complex_poly ww in

              for j = 0 to n_n do

               let divisor = z.(j) in

                if complex_module divisor > seuil then

                 begin

                  accu_complex := Matrix.matrix_float_plus !accu_complex ( Matrix.matrix_float_prod zz.(j) ( complex_inv divisor ) ) ;

                  accu_integer := succ !accu_integer ;

                 end ;

              done ;

              let coeff = clean_complex ( Matrix.matrix_float_scal_left_div ( float !accu_integer ) !accu_complex ) in

               accu_complex := complex_0 ;

               accu_integer := 0 ;

               spectrum.(i) <- Matrix.matrix_float_plus candidate_value ( complex_inv coeff ) ;

         end

        else

         begin

          spectrum.(i) <- candidate_value ;

          let k = methode_ker difference in

           let kk = Array.length k in

            let v = Matrix.vector_float_bal_random kk 10. in

             let w_w = ( Matrix.matrix_vector_float_prod ( Matrix.float_transpose k ) ( Matrix.vector_float_scal_mult ( 1. /. ( Matrix.vector_float_norm_2 v ) ) v ) ) in

              let w_coeff = 1. /. ( Matrix.vector_float_norm_2 w_w ) in

               let w = Matrix.vector_float_scal_mult w_coeff w_w in

                trans_passage.(i) <- Matrix.vector_float_copy w ;

                trans_passage.( n + i ) <- vector_complex_i_times w ;

         end ;

    done ;

    [| spectrum ; [| Matrix.float_transpose trans_passage |] ; [| trans_passage  |] |] ;; 






(** 
direct_complex_spectrum threshold_qr threshold steps_qr steps matrix
 The first number of steps steps_qr 
is the one used in the QR algorithm of Francis ; the second number steps is the one used in the inverse iteration
The matrix is supposed to be diagonalizable.



La matrice est supposée diagonalisable.
Le premier nombre maximal de pas steps_qr est celui utilisé pour l'algorithme QR de Francis ;
le deuxième steps est celui utilisé dans l'itération inverse.
 *)


let direct_complex_spectrum = fun (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (m:float array array) ->

 let res = complex_francis_schur_decomposition threshold_qr threshold steps_qr m

 and seuil = sqrt epsilon_float

 and nn = Array.length m

 and accu_integer = ref 0

 and accu_complex = ref complex_0 in

  let p = Array.map clean_complex ( matrix_complex_extract_diag_to_poly res.(0) )

  and q = Matrix.float_transpose res.(1)

  and n = nn / 2 in

   let spectrum = Array.make n complex_0

   and n_n = n - 1 in

    for i = 0 to n_n do

     let candidate_value = p.(i) in

      let difference = Matrix.matrix_float_minus m ( scal_complex n n candidate_value ) in

       let test = Matrix.float_invertibility difference in

        if test then

         begin

          let mm = Matrix.clean_inv difference in

           let w = Matrix.float_normalized_iterate Matrix.vector_float_norm_2 steps mm q.(i) in

            let ww = Matrix.matrix_vector_float_prod mm w

            and z = complex_vector_to_complex_poly w in

             let zz = complex_vector_to_complex_poly ww in

              for j = 0 to n_n do

               let divisor = z.(j) in

                if complex_module divisor > seuil then

                 begin

                  accu_complex := Matrix.matrix_float_plus !accu_complex ( Matrix.matrix_float_prod zz.(j) ( complex_inv divisor ) ) ;

                  accu_integer := succ !accu_integer ;

                 end ;

              done ;

              let coeff = clean_complex ( Matrix.matrix_float_scal_left_div ( float !accu_integer ) !accu_complex ) in

               accu_complex := complex_0 ;

               accu_integer := 0 ;

               spectrum.(i) <- Matrix.matrix_float_plus candidate_value ( complex_inv coeff ) ;

         end

        else

          spectrum.(i) <- candidate_value ;

    done ;

    spectrum ;;






(** 
direct_complex_shifted_spectrum threshold_qr threshold steps_qr steps shift matrix
 The first number of steps steps_qr 
is the one used in the QR algorithm of Francis ; the second number steps is the one used in the inverse iteration
The matrix is supposed to be diagonalizable.



La matrice est supposée diagonalisable.
Le premier nombre maximal de pas steps_qr est celui utilisé pour l'algorithme QR de Francis ;
le deuxième steps est celui utilisé dans l'itération inverse.
 *)


let direct_complex_shifted_spectrum = fun (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (shift:float array array) (m:float array array) ->

 let res = complex_shifted_francis_schur_decomposition threshold_qr threshold steps_qr shift m

 and seuil = sqrt epsilon_float

 and nn = Array.length m

 and accu_integer = ref 0

 and accu_complex = ref complex_0 in

  let p = Array.map clean_complex ( matrix_complex_extract_diag_to_poly res.(0) )

  and q = Matrix.float_transpose res.(1)

  and n = nn / 2 in

   let spectrum = Array.make n complex_0

   and n_n = n - 1 in

    for i = 0 to n_n do

     let candidate_value = p.(i) in

      let difference = Matrix.matrix_float_minus m ( scal_complex n n candidate_value ) in

       let test = Matrix.float_invertibility difference in

        if test then

         begin

          let mm = Matrix.clean_inv difference in

           let w = Matrix.float_normalized_iterate Matrix.vector_float_norm_2 steps mm q.(i) in

            let ww = Matrix.matrix_vector_float_prod mm w

            and z = complex_vector_to_complex_poly w in

             let zz = complex_vector_to_complex_poly ww in

              for j = 0 to n_n do

               let divisor = z.(j) in

                if complex_module divisor > seuil then

                 begin

                  accu_complex := Matrix.matrix_float_plus !accu_complex ( Matrix.matrix_float_prod zz.(j) ( complex_inv divisor ) ) ;

                  accu_integer := succ !accu_integer ;

                 end ;

              done ;

              let coeff = clean_complex ( Matrix.matrix_float_scal_left_div ( float !accu_integer ) !accu_complex ) in

               accu_complex := complex_0 ;

               accu_integer := 0 ;

               spectrum.(i) <- Matrix.matrix_float_plus candidate_value ( complex_inv coeff ) ;

         end

        else

          spectrum.(i) <- candidate_value ;

    done ;

    spectrum ;;






(** 
complex_tune_diagonalization factor methode_diag matrix passage_candidate

This function may be unstable.
The matrix is supposed to be diagonalizable.
The output is the same as for direct_complex_diagonalization.



La sortie est la même que pour direct_complex_diagonalization.
La matrice est supposée diagonalisable.
Cette fonction peut être instable. *)


let complex_tune_diagonalization = fun (factor:float) methode_diag (m:float array array) (p:float array array) ->

 let n = ( Array.length p ) / 2

 and p_r = matrix_complex_real_part p

 and p_i = matrix_complex_imag_part p in

  let f = function y -> Matrix.matrix_float_bal_random n n y

  and x = factor *. ( Matrix.matrix_float_norm_inf p ) /. ( float n ) in

   let a = f x

   and b = f x in

    let pa = Matrix.matrix_float_plus p_r a

    and pb = Matrix.matrix_float_plus p_i b in

     let aa = matrix_real_to_complex pa

     and bb = matrix_imag_to_complex pb in

      let pp = Matrix.matrix_float_plus aa bb in

       let q = Matrix.clean_inv pp in

        let r = Matrix.matrix_float_triple_prod q m pp in

         methode_diag r ;;






(** 
indirect_complex_diagonalization factor methode_ker threshold_qr threshold steps_qr steps_power matrix

The results are often worse than with the function direct_complex_diagonalization
but may be enhanced sometimes by playing with the parameters.
This function may be unstable.
The matrix is supposed to be diagonalizable.
The output is the same as for direct_complex_diagonalization.



La sortie est la même que pour direct_complex_diagonalization.
La matrice est supposée diagonalisable.
Les résultats sont parfois moins bons qu'avec la fonction direct_complex_diagonalization
mais peuvent être améliorés parfois en jouant sur les paramètres.
Cette fonction peut être instable. *)


let indirect_complex_diagonalization = fun (factor:float) methode_ker (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (m:float array array) ->

 let res = direct_complex_diagonalization methode_ker threshold_qr threshold steps_qr steps m in

  let p = res.(1).(0) and tp = res.(2).(0) in

   let result = complex_tune_diagonalization factor ( direct_complex_diagonalization methode_ker threshold_qr threshold steps_qr steps ) m p in

    let new_p = Matrix.matrix_float_prod p result.(1).(0)

    and new_tp = Matrix.matrix_float_prod result.(2).(0) tp in

     [| result.(0) ; [| new_p |] ; [| new_tp |] |] ;;






(** 
indirect_complex_shifted_diagonalization factor methode_ker threshold_qr threshold steps_qr steps_power shift matrix

The results are often worse than with the function direct_complex_diagonalization
but may be enhanced sometimes by playing with the parameters.
This function may be unstable.
The matrix is supposed to be diagonalizable.
The output is the same as for direct_complex_diagonalization.



La sortie est la même que pour direct_complex_diagonalization.
La matrice est supposée diagonalisable.
Les résultats sont parfois moins bons qu'avec la fonction direct_complex_diagonalization
mais peuvent être améliorés parfois en jouant sur les paramètres.
Cette fonction peut être instable. *)


let indirect_complex_shifted_diagonalization = fun (factor:float) methode_ker (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (shift:float array array) (m:float array array) ->

 let res = direct_complex_shifted_diagonalization methode_ker threshold_qr threshold steps_qr steps shift m in

  let p = res.(1).(0) and tp = res.(2).(0) in

   let result = complex_tune_diagonalization factor ( direct_complex_shifted_diagonalization methode_ker threshold_qr threshold steps_qr steps shift ) m p in

    let new_p = Matrix.matrix_float_prod p result.(1).(0)

    and new_tp = Matrix.matrix_float_prod result.(2).(0) tp in

     [| result.(0) ; [| new_p |] ; [| new_tp |] |] ;;






(** 
direct_complex_compensated_spectrum accelerator stages factor methode_ker threshold_qr threshold steps_qr steps matrix
 
The accelerator is appied to real vectors. The factor must be chosen 0 and 1.



L'accélérateur accelerator s'applique aux vecteurs réels. Le facteur factor doit être choisi entre 0 et 1. *)


let direct_complex_compensated_spectrum = fun accelerator (stages:int) (factor:float) methode_ker (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (m:float array array) ->

 let f = fun n p -> int_of_float ( ( factor ** ( float p ) ) *. ( float n ) )

 and s = Array.make_matrix stages 1 complex_0

 and etapes = pred stages in

  for i = 0 to pred etapes do

   s.(i) <- direct_complex_spectrum threshold_qr threshold steps_qr ( f steps ( etapes - i ) ) m

  done ;

  s.(etapes) <- direct_complex_spectrum threshold_qr threshold steps_qr steps m ;

  let sequence = Array.map complex_poly_to_complex_vector s in

   let limit = accelerator sequence in

    complex_vector_to_complex_poly limit ;;






(** 
direct_complex_compensated_shifted_spectrum accelerator stages factor methode_ker threshold_qr threshold steps_qr steps shift matrix
 
The accelerator is appied to real vectors. The factor must be chosen 0 and 1.



L'accélérateur accelerator s'applique aux vecteurs réels. Le facteur factor doit être choisi entre 0 et 1. *)


let direct_complex_compensated_shifted_spectrum = fun accelerator (stages:int) (factor:float) methode_ker (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (shift:float array array) (m:float array array) ->

 let f = fun n p -> int_of_float ( ( factor ** ( float p ) ) *. ( float n ) )

 and s = Array.make_matrix stages 1 complex_0

 and etapes = pred stages in

  for i = 0 to pred etapes do

   s.(i) <- direct_complex_shifted_spectrum threshold_qr threshold steps_qr ( f steps ( etapes - i ) ) shift m

  done ;

  s.(etapes) <- direct_complex_shifted_spectrum threshold_qr threshold steps_qr steps shift m ;

  let sequence = Array.map complex_poly_to_complex_vector s in

   let limit = accelerator sequence in

    complex_vector_to_complex_poly limit ;;






(** 
complex_compensated_spectrum accelerator stages factor threshold_qr threshold steps_qr steps matrix
 
The accelerator is appied to real vectors. The factor must be chosen 0 and 1.



L'accélérateur accelerator s'applique aux vecteurs réels. Le facteur factor doit être choisi entre 0 et 1. *)


let complex_compensated_spectrum = fun accelerator (stages:int) (factor:float) (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (m:float array array) ->

 let f = fun n p -> int_of_float ( ( factor ** ( float p ) ) *. ( float n ) )

 and s = Array.make_matrix stages 1 complex_0

 and etapes = pred stages in

  for i = 0 to pred etapes do

   s.(i) <- direct_complex_spectrum threshold_qr threshold steps_qr ( f steps ( etapes - i ) ) m

  done ;

  s.(etapes) <- direct_complex_spectrum threshold_qr threshold steps_qr steps m ;

  let sequence = Array.map complex_poly_to_complex_vector s in

   let limit = accelerator sequence in

    complex_vector_to_complex_poly limit ;;






(** 
complex_compensated_shifted_spectrum accelerator stages factor threshold_qr threshold steps_qr steps shift matrix
 
The accelerator is appied to real vectors. The factor must be chosen 0 and 1.



L'accélérateur accelerator s'applique aux vecteurs réels. Le facteur factor doit être choisi entre 0 et 1. *)


let complex_compensated_shifted_spectrum = fun accelerator (stages:int) (factor:float) (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (shift:float array array) (m:float array array) ->

 let f = fun n p -> int_of_float ( ( factor ** ( float p ) ) *. ( float n ) )

 and s = Array.make_matrix stages 1 complex_0

 and etapes = pred stages in

  for i = 0 to pred etapes do

   s.(i) <- direct_complex_shifted_spectrum threshold_qr threshold steps_qr ( f steps ( etapes - i ) ) shift m

  done ;

  s.(etapes) <- direct_complex_shifted_spectrum threshold_qr threshold steps_qr steps shift m ;

  let sequence = Array.map complex_poly_to_complex_vector s in

   let limit = accelerator sequence in

    complex_vector_to_complex_poly limit ;;






(** 
largo_complex_compensated_spectrum accelerator_sci_1024 stages factor threshold_qr threshold steps_qr steps matrix
 
The accelerator is appied to complex numbers with extended precision, like Sci.approx_1024. 
The factor must be chosen 0 and 1.



L'accélérateur accelerator s'applique aux nombres complexes en précision étendue, comme Sci.approx_1024. 
Le facteur factor doit être choisi entre 0 et 1. *)


let largo_complex_compensated_spectrum = fun accelerator (stages:int) (factor:float) (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (m:float array array) ->

 let f = fun n p -> int_of_float ( ( factor ** ( float p ) ) *. ( float n ) )

 and s = Array.make_matrix stages 1 complex_0

 and etapes = pred stages in

  for i = 0 to pred etapes do

   s.(i) <- direct_complex_spectrum threshold_qr threshold steps_qr ( f steps ( etapes - i ) ) m

  done ;

  s.(etapes) <- direct_complex_spectrum threshold_qr threshold steps_qr steps m ;

  let sequence = Util.transpose s in

   let seq = Array.map poly_complex_to_sci sequence in

    let limits = Array.map accelerator seq in

     poly_sci_to_complex limits ;;






(** 
largo_complex_compensated_shifted_spectrum accelerator_sci_1024 stages factor threshold_qr threshold steps_qr steps shift matrix
 
The accelerator is appied to complex numbers with extended precision, like Sci.approx_1024. 
The factor must be chosen 0 and 1.



L'accélérateur accelerator s'applique aux nombres complexes en précision étendue, comme Sci.approx_1024. 
Le facteur factor doit être choisi entre 0 et 1. *)


let largo_complex_compensated_shifted_spectrum = fun accelerator (stages:int) (factor:float) (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) (shift:float array array) (m:float array array) ->

 let f = fun n p -> int_of_float ( ( factor ** ( float p ) ) *. ( float n ) )

 and s = Array.make_matrix stages 1 complex_0

 and etapes = pred stages in

  for i = 0 to pred etapes do

   s.(i) <- direct_complex_shifted_spectrum threshold_qr threshold steps_qr ( f steps ( etapes - i ) ) shift m

  done ;

  s.(etapes) <- direct_complex_shifted_spectrum threshold_qr threshold steps_qr steps shift m ;

  let sequence = Util.transpose s in

   let seq = Array.map poly_complex_to_sci sequence in

    let limits = Array.map accelerator seq in

     poly_sci_to_complex limits ;;






(** 
clean_complex_spectrum stages steps matrix
 *)


let clean_complex_spectrum = fun (stages:int) (steps:int) (m:float array array) ->

 largo_complex_compensated_spectrum Sci.approx_1024 stages 0.58 0. 0. steps steps m ;;






(** 
clean_complex_shifted_spectrum stages steps shift matrix
 *)


let clean_complex_shifted_spectrum = fun (stages:int) (steps:int) (shift:float array array) (m:float array array) ->

 largo_complex_compensated_shifted_spectrum Sci.approx_1024 stages 0.58 0. 0. steps steps shift m ;;








(** 
poly_complex_raw_roots spectrum_methode jordan_decomposition_methode polynomial
 *)


let poly_complex_raw_roots = fun spectrum_methode jordan_decomposition_methode (p:float array array array) ->

 spectrum_methode ( jordan_decomposition_methode p ( complex_companion p ) ).(0) ;;






(** 
poly_real_complex_raw_roots spectrum_method jordan_decomposition_methode real_polynomial
 *)


let poly_real_complex_raw_roots = fun spectrum_methode jordan_decomposition_methode (p:float array) ->

 let q = poly_real_to_complex p in

  spectrum_methode ( jordan_decomposition_methode q ( complex_companion q ) ).(0) ;;






(** 
poly_complex_tune_root_step eval_rule polynomial derivative_array threshold candidate
 
The array of successive derivatives derivative_array must contain at least p and p'.
A good value for threshold may lie between min_float and epsilon_float.
Output : estimated root, estimated multiplicity, module of the evaluation of the polynomial at the estimated root, 
successive derivative array.



Sortie : racine estimée, multiplicité estimée, module de l'évaluation du polynôme en la racine, tableau des dérivées successives.
Le tableau de dérivées successives doit contenir au moins p et p'.
Une bonne valeur pour le seuil threshold peut être entre min_float et epsilon_float. *)


let poly_complex_tune_root_step = fun eval_rule (p:float array array array) (derivative_array:float array array array array) (threshold:float) (z0:float array array) ->

 let z = ref z0

 and mult = ref 1

 and old_z = ref z0

 and error = ref max_float

 and old_error = ref ( complex_module ( eval_rule p z0 ) )

 and d = int_of_float ( poly_complex_deg p )

 and i = ref 1

 and deriv = ref derivative_array in

  if !old_error <= threshold then

   begin

    while !i < d do

     let last_deriv = !deriv.(!i) in

      error := complex_module ( eval_rule !deriv.(!i) z0 ) ;

      if !error > threshold then ( mult := !i ; i := d )

      else

       begin

        i := !i + 1  ;

        if ( Array.length !deriv ) <= !i then ( deriv := Array.append !deriv [| poly_complex_deriv last_deriv |] ) ;

       end

    done ;

    [| [|[| !z ; [|[| float !mult |]|] ; [|[| !old_error |]|] |]|] ; !deriv |]

   end

  else

   begin

    while !i < d do

     let last_deriv = !deriv.(!i) in

      let denom = ( eval_rule last_deriv z0 ) in

       if complex_module denom <= threshold then

        begin

         old_error := !error ;

         i := !i + 1 ;

         if ( Array.length !deriv ) <= !i then ( deriv := Array.append !deriv [| poly_complex_deriv last_deriv |] ) ;

        end

       else

        begin

         let quotient = Matrix.matrix_float_prod ( eval_rule ( !deriv.( !i - 1 ) ) z0 ) ( complex_inv denom ) in

          old_z := !z ;

          z := clean_complex ( Matrix.matrix_float_minus z0 ( Matrix.matrix_float_scal_mult ( float !i ) quotient ) ) ;

          old_error := !error ;

          error := complex_module ( eval_rule p !z ) ;

           if !error > !old_error then ( z := !old_z ; error := !old_error ; i := d )

           else

            begin

             mult := !mult + 1 ;

             i := !i + 1 ;

             if ( Array.length !deriv ) <= !i then ( deriv := Array.append !deriv [| poly_complex_deriv last_deriv |] ) ;

            end

        end

    done ;

    [| [|[| !z ; [|[| float ( !mult ) |]|] ; [|[| !error |]|] |]|] ; !deriv |]

   end ;;






(** 
poly_complex_tune_roots eval_rule threshold mult_threshold max_steps candidates complex_polynomial

Output : estimated roots, estimated multiplicities with mult_threshold, means of estimated multiplicities during
the iteration, modules of the evaluations of the polynomial at the estimated roots, successive derivative array.



Sortie : racines estimées, multiplicités estimées avec mult_threshold, moyenne des multiplicités estimées pendant l'itération,
modules des évaluations du polynôme en les racines, tableau des dérivées successives. *)


let poly_complex_tune_roots = fun eval_rule (threshold:float) (mult_threshold:float) (steps:int) (candidates:float array array array) (p:float array array array) ->

 let f = function x -> complex_module ( eval_rule p x )

 and derivative_array = ref [| p ; poly_complex_deriv p |]

 and d = int_of_float ( poly_complex_deg p ) in

  let dd = d - 1

  and j = ref 1

  and old_error = Array.make d max_float

  and error = Array.map f candidates

  and mult = Array.make_matrix d 1 1.

  and multiplicity = Array.make d 1.

  and multip = Array.make d 1.

  and accu = ref d

  and roots = poly_complex_copy candidates

  and old_roots = Array.make d complex_0 in

   for i = 0 to dd do

    while !j < steps do

     let result = poly_complex_tune_root_step eval_rule p !derivative_array threshold roots.(i) in

      mult.(i) <- Array.append mult.(i) [| result.(0).(0).(1).(0).(0) |] ;

      if Array.length !derivative_array < Array.length result.(1) then derivative_array := result.(1) ;

      let test = result.(0).(0).(2).(0).(0) in

       if test > old_error.(i) then j := max_int

       else 

        begin

         old_roots.(i) <- roots.(i) ;

         roots.(i) <- result.(0).(0).(0) ;

         old_error.(i) <- error.(i) ;

         error.(i) <- test ;

         j := !j + 1 ;

        end

    done ;

    multiplicity.(i) <- Matrix.vector_float_mean mult.(i) ;

    j := 1 ;

     while !j < d do

      if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_complex_deriv !derivative_array.( !j - 1 ) |] ;

      let essai = complex_module ( eval_rule !derivative_array.(!j) roots.(i) ) in

       if essai > mult_threshold then ( accu := !j ; j := d ) ;

       j := !j + 1 ;

     done ;

    multip.(i) <- float !accu ;

    j := 1 ;

   done ;

   [| [| roots ; [|[| multip |]|] ; [|[| multiplicity |]|] ; [|[| error |]|] |] ; !derivative_array |] ;;






(** 
poly_sci_tune_root_step eval_rule polynomial derivative_array threshold candidate
 
The array of successive derivatives derivative_array must contain at least p and p'.
A good value for threshold may lie between min_float and epsilon_float.
Output : estimated root, estimated multiplicity, module of the evaluation of the polynomial at the estimated root, 
successive derivative array.



Sortie : racine estimée, multiplicité estimée, module de l'évaluation du polynôme en la racine, tableau des dérivées successives.
Le tableau de dérivées successives doit contenir au moins p et p'.
Une bonne valeur pour le seuil threshold peut être entre min_float et epsilon_float. *)


let poly_sci_tune_root_step = fun eval_rule (p:Num.num array array) (derivative_array:Num.num array array array) (threshold:float) (z0:Num.num array) ->

 let z = ref z0

 and mult = ref 1

 and old_z = ref z0

 and error = ref max_float

 and old_error = ref ( complex_module ( Sci.complex_of_sci ( eval_rule p z0 ) ) )

 and d = int_of_float ( poly_sci_deg p )

 and i = ref 1

 and deriv = ref derivative_array in

  if !old_error <= threshold then

   begin

    while !i < d do

     let last_deriv = !deriv.(!i) in

      error := complex_module ( Sci.complex_of_sci ( eval_rule !deriv.(!i) z0 ) ) ;

      if !error > threshold then ( mult := !i ; i := d )

      else

       begin

        i := !i + 1  ;

        if ( Array.length !deriv ) <= !i then ( deriv := Array.append !deriv [| poly_sci_deriv last_deriv |] ) ;

       end

    done ;

    [| [|[| !z ; Sci.sci_of_int !mult ; Sci.sci_of_float !old_error |]|] ; !deriv |]

   end

  else

   begin

    while !i < d do

     let last_deriv = !deriv.(!i) in

      let denom = ( eval_rule last_deriv z0 ) in

       if complex_module ( Sci.complex_of_sci denom ) <= threshold then

        begin

         old_error := !error ;

         i := !i + 1 ;

         if ( Array.length !deriv ) <= !i then ( deriv := Array.append !deriv [| poly_sci_deriv last_deriv |] ) ;

        end

       else

        begin

         let quotient = Sci.mult ( eval_rule ( !deriv.( !i - 1 ) ) z0 ) ( Sci.inv denom ) in

          old_z := !z ;

          z := Sci.minus z0 ( Sci.mult ( Sci.format [| Num.num_of_int !i ; Sci.num_0 ; Sci.num_0 |] ) quotient ) ;

          old_error := !error ;

          error := complex_module ( Sci.complex_of_sci ( eval_rule p !z ) ) ;

           if !error > !old_error then ( z := !old_z ; error := !old_error ; i := d )

           else

            begin

             mult := !mult + 1 ;

             i := !i + 1 ;

             if ( Array.length !deriv ) <= !i then ( deriv := Array.append !deriv [| poly_sci_deriv last_deriv |] ) ;

            end

        end

    done ;

    [| [|[| !z ; Sci.sci_of_int ( !mult ) ; Sci.sci_of_float !error |]|] ; !deriv |]

   end ;;






(** 
poly_sci_tune_roots eval_rule threshold mult_threshold max_steps candidates sci_polynomial

Output : estimated roots, estimated multiplicities with mult_threshold, means of estimated multiplicities during
the iteration, modules of the evaluations of the polynomial at the estimated roots, successive derivative array.



Sortie : racines estimées, multiplicités estimées avec mult_threshold, moyenne des multiplicités estimées pendant l'itération,
carrés des modules des évaluations du polynôme en les racines, tableau des dérivées successives. *)


let poly_sci_tune_roots = fun eval_rule (threshold:float) (mult_threshold:float) (steps:int) (candidates:Num.num array array) (p:Num.num array array) ->

 let f = function x -> complex_module ( Sci.complex_of_sci ( eval_rule p x ) )

 and derivative_array = ref [| p ; poly_sci_deriv p |]

 and d = int_of_float ( poly_sci_deg p ) in

  let dd = d - 1

  and j = ref 1

  and old_error = Array.make d max_float

  and error = Array.map f candidates

  and mult = Array.make_matrix d 1 1.

  and multiplicity = Array.make d 1.

  and multip = Array.make d 1

  and accu = ref d

  and roots = poly_sci_copy candidates

  and old_roots = Array.make d Sci.sci_0 in

   for i = 0 to dd do

    while !j < steps do

     let result = poly_sci_tune_root_step eval_rule p !derivative_array threshold roots.(i) in

      mult.(i) <- Array.append mult.(i) [| ( Sci.complex_of_sci result.(0).(0).(1) ).(0).(0) |] ;

      if Array.length !derivative_array < Array.length result.(1) then derivative_array := result.(1) ;

      let test = ( Sci.complex_of_sci result.(0).(0).(2) ).(0).(0) in

       if test > old_error.(i) then j := max_int

       else 

        begin

         old_roots.(i) <- roots.(i) ;

         roots.(i) <- result.(0).(0).(0) ;

         old_error.(i) <- error.(i) ;

         error.(i) <- test ;

         j := !j + 1 ;

        end

    done ;

    multiplicity.(i) <- Matrix.vector_float_mean mult.(i) ;

    j := 1 ;

     while !j < d do

      if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_sci_deriv !derivative_array.( !j - 1 ) |] ;

      let essai = ( complex_module ( Sci.complex_of_sci ( eval_rule !derivative_array.(!j) roots.(i) ) ) ) in

       if essai > mult_threshold then ( accu := !j ; j := d ) ;

       j := !j + 1 ;

     done ;

    multip.(i) <- !accu ;

    j := 1 ;

   done ;

   [| [| roots ; Array.map Sci.sci_of_int multip ; Array.map Sci.sci_of_float multiplicity ; Array.map Sci.sci_of_float error |] ; !derivative_array |] ;;






(** 
poly_sci_1024_tune_root_step eval_rule polynomial derivative_array threshold candidate
 
The array of successive derivatives derivative_array must contain at least p and p'.
A good value for threshold may lie between min_float and epsilon_float.
Output : estimated root, estimated multiplicity, module of the evaluation of the polynomial at the estimated root, 
successive derivative array.



Sortie : racine estimée, multiplicité estimée, module de l'évaluation du polynôme en la racine, tableau des dérivées successives.
Le tableau de dérivées successives doit contenir au moins p et p'.
Une bonne valeur pour le seuil threshold peut être entre min_float et epsilon_float. *)


let poly_sci_1024_tune_root_step = fun eval_rule (p:Num.num array array) (derivative_array:Num.num array array array) (threshold:float) (z0:Num.num array) ->

 let z = ref z0

 and mult = ref 1

 and old_z = ref z0

 and error = ref max_float

 and old_error = ref ( complex_module ( Sci.complex_of_sci ( eval_rule p z0 ) ) )

 and d = int_of_float ( poly_sci_deg p )

 and i = ref 1

 and deriv = ref derivative_array in

  if !old_error <= threshold then

   begin

    while !i < d do

     let last_deriv = !deriv.(!i) in

      error := complex_module ( Sci.complex_of_sci ( eval_rule !deriv.(!i) z0 ) ) ;

      if !error > threshold then ( mult := !i ; i := d )

      else

       begin

        i := !i + 1  ;

        if ( Array.length !deriv ) <= !i then ( deriv := Array.append !deriv [| poly_sci_1024_deriv last_deriv |] ) ;

       end

    done ;

    [| [|[| !z ; Sci.sci_of_int !mult ; Sci.sci_of_float !old_error |]|] ; !deriv |]

   end

  else

   begin

    while !i < d do

     let last_deriv = !deriv.(!i) in

      let denom = ( eval_rule last_deriv z0 ) in

       if complex_module ( Sci.complex_of_sci denom ) <= threshold then

        begin

         old_error := !error ;

         i := !i + 1 ;

         if ( Array.length !deriv ) <= !i then ( deriv := Array.append !deriv [| poly_sci_1024_deriv last_deriv |] ) ;

        end

       else

        begin

         let quotient = Sci.mult_1024 ( eval_rule ( !deriv.( !i - 1 ) ) z0 ) ( Sci.inv_1024 denom ) in

          old_z := !z ;

          z := Sci.minus_1024 z0 ( Sci.mult_1024 ( Sci.format_1024 [| Num.num_of_int !i ; Sci.num_0 ; Sci.num_0 |] ) quotient ) ;

          old_error := !error ;

          error := complex_module ( Sci.complex_of_sci ( eval_rule p !z ) ) ;

           if !error > !old_error then ( z := !old_z ; error := !old_error ; i := d )

           else

            begin

             mult := !mult + 1 ;

             i := !i + 1 ;

             if ( Array.length !deriv ) <= !i then ( deriv := Array.append !deriv [| poly_sci_1024_deriv last_deriv |] ) ;

            end

        end

    done ;

    [| [|[| !z ; Sci.sci_of_int ( !mult ) ; Sci.sci_of_float !error |]|] ; !deriv |]

   end ;;






(** 
poly_sci_1024_tune_roots eval_rule threshold mult_threshold max_steps candidates sci_polynomial

Output : estimated roots, estimated multiplicities with mult_threshold, means of estimated multiplicities during
the iteration, modules of the evaluations of the polynomial at the estimated roots, successive derivative array.



Sortie : racines estimées, multiplicités estimées avec mult_threshold, moyenne des multiplicités estimées pendant l'itération,
carrés des modules des évaluations du polynôme en les racines, tableau des dérivées successives. *)


let poly_sci_1024_tune_roots = fun eval_rule (threshold:float) (mult_threshold:float) (steps:int) (candidates:Num.num array array) (p:Num.num array array) ->

 let f = function x -> complex_module ( Sci.complex_of_sci ( eval_rule p x ) )

 and derivative_array = ref [| p ; poly_sci_1024_deriv p |]

 and d = int_of_float ( poly_sci_deg p ) in

  let dd = d - 1

  and j = ref 1

  and old_error = Array.make d max_float

  and error = Array.map f candidates

  and mult = Array.make_matrix d 1 1.

  and multiplicity = Array.make d 1.

  and multip = Array.make d 1

  and accu = ref d

  and roots = poly_sci_copy candidates

  and old_roots = Array.make d Sci.sci_0 in

   for i = 0 to dd do

    while !j < steps do

     let result = poly_sci_1024_tune_root_step eval_rule p !derivative_array threshold roots.(i) in

      mult.(i) <- Array.append mult.(i) [| ( Sci.complex_of_sci result.(0).(0).(1) ).(0).(0) |] ;

      if Array.length !derivative_array < Array.length result.(1) then derivative_array := result.(1) ;

      let test = ( Sci.complex_of_sci result.(0).(0).(2) ).(0).(0) in

       if test > old_error.(i) then j := max_int

       else 

        begin

         old_roots.(i) <- roots.(i) ;

         roots.(i) <- result.(0).(0).(0) ;

         old_error.(i) <- error.(i) ;

         error.(i) <- test ;

         j := !j + 1 ;

        end

    done ;

    multiplicity.(i) <- Matrix.vector_float_mean mult.(i) ;

    j := 1 ;

     while !j < d do

      if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_sci_1024_deriv !derivative_array.( !j - 1 ) |] ;

      let essai = complex_module ( Sci.complex_of_sci ( eval_rule !derivative_array.(!j) roots.(i) ) ) in

       if essai > mult_threshold then ( accu := !j ; j := d ) ;

       j := !j + 1 ;

     done ;

    multip.(i) <- !accu ;

    j := 1 ;

   done ;

   [| [| roots ; Array.map Sci.sci_of_int multip ; Array.map Sci.sci_of_float multiplicity ; Array.map Sci.sci_of_float error |] ; !derivative_array |] ;;






(** 
poly_real_complex_tune_roots eval_rule threshold mult_threshold max_steps candidates real_polynomial
 *)


let poly_real_complex_tune_roots = fun eval_rule (threshold:float) (mult_threshold:float) (steps:int) (candidates:float array array array) (p:float array) ->

 poly_complex_tune_roots eval_rule threshold mult_threshold steps candidates ( poly_real_to_complex p ) ;;






(** 
lento_poly_complex_tune_roots eval_rule threshold mult_threshold steps candidates polynomial
 *)


let lento_poly_complex_tune_roots = fun eval_rule (threshold:float) (mult_threshold:float) (steps:int) (candidates:float array array array) (p:float array array array) ->

 let f = Array.map ( Array.map ( Sci.complex_of_sci ) ) in

  Array.map f ( poly_sci_tune_roots eval_rule threshold mult_threshold steps ( Array.map Sci.sci_of_complex candidates ) ( Array.map Sci.sci_of_complex p ) ) ;;






(** 
lento_poly_real_complex_tune_roots eval_rule threshold mult_threshold steps candidates polynomial
 *)


let lento_poly_real_complex_tune_roots = fun eval_rule (threshold:float) (mult_threshold:float) (steps:int) (candidates:float array array array) (p:float array) ->

 let f = Array.map ( Array.map ( Sci.complex_of_sci ) ) in

  Array.map f (  poly_sci_tune_roots eval_rule threshold mult_threshold steps ( Array.map Sci.sci_of_complex candidates ) ( Array.map Sci.sci_of_float p ) ) ;;






(** 
largo_poly_complex_tune_roots eval_rule threshold mult_threshold steps candidates polynomial
 *)


let largo_poly_complex_tune_roots = fun eval_rule (threshold:float) (mult_threshold:float) (steps:int) (candidates:float array array array) (p:float array array array) ->

 let f = Array.map ( Array.map ( Sci.complex_of_sci ) ) in

  Array.map f ( poly_sci_1024_tune_roots eval_rule threshold mult_threshold steps ( Array.map Sci.sci_of_complex candidates ) ( Array.map Sci.sci_of_complex p ) ) ;;






(** 
largo_poly_real_complex_tune_roots eval_rule threshold mult_threshold steps candidates polynomial
 *)


let largo_poly_real_complex_tune_roots = fun eval_rule (threshold:float) (mult_threshold:float) (steps:int) (candidates:float array array array) (p:float array) ->

 let f = Array.map ( Array.map ( Sci.complex_of_sci ) ) in

  Array.map f (  poly_sci_1024_tune_roots eval_rule threshold mult_threshold steps ( Array.map Sci.sci_of_complex candidates ) ( Array.map Sci.sci_of_float p ) ) ;;






(** 
poly_aitken_seki_1024_tune_roots eval_rule threshold mult_threshold candidates polynomial
 *)


let poly_aitken_seki_1024_tune_roots = fun eval_rule (threshold:float) (mult_threshold:float) (candidates:Num.num array array) (p:Num.num array array) ->

 let l = Array.length candidates

 and derivative_array = ref [| p ; poly_sci_deriv p |]

 and j = ref 1

 and d = int_of_float ( poly_sci_deg p ) in

  let z = Array.make l Sci.sci_0

  and accu = ref d

  and multip = Array.make d 1 in

   for i = 0 to l - 1 do

    let ra = candidates.(i) in

     let rb = poly_sci_1024_tune_root_step eval_rule p !derivative_array threshold ra in

      let rc = poly_sci_1024_tune_root_step eval_rule p rb.(1) threshold rb.(0).(0).(0) in

       let rd = Sci.aitken_seki_1024 ra rb.(0).(0).(0) rc.(0).(0).(0) in

        z.(i) <- rd ;

        derivative_array := rc.(1) ;

        j := 1 ;

        while !j < d do

         if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_sci_1024_deriv !derivative_array.( !j - 1 ) |] ;

         let essai = complex_module ( Sci.complex_of_sci ( eval_rule !derivative_array.(!j) rd ) ) in

          if essai > mult_threshold then ( accu := !j ; j := d ) ;

          j := !j + 1 ;

        done ;

        multip.(i) <- !accu ;

        j := 1 ;

   done ;

   [| [| z ; Array.map Sci.sci_of_int multip |] ; !derivative_array |] ;;






(** 
poly_shanks2_1024_tune_roots eval_rule threshold mult_threshold candidates polynomial
 *)


let poly_shanks2_1024_tune_roots = fun eval_rule (threshold:float) (mult_threshold:float) (candidates:Num.num array array) (p:Num.num array array) ->

 let l = Array.length candidates

 and derivative_array = ref [| p ; poly_sci_deriv p |]

 and j = ref 1

 and d = int_of_float ( poly_sci_deg p ) in

  let z = Array.make l Sci.sci_0

  and accu = ref d

  and multip = Array.make d 1 in

   for i = 0 to l - 1 do

    let ra = candidates.(i) in

     let rb = poly_sci_1024_tune_root_step eval_rule p !derivative_array threshold ra in

      let rc = poly_sci_1024_tune_root_step eval_rule p rb.(1) threshold rb.(0).(0).(0) in

       let rd = poly_sci_1024_tune_root_step eval_rule p rc.(1) threshold rc.(0).(0).(0) in

        let re = poly_sci_1024_tune_root_step eval_rule p rd.(1) threshold rd.(0).(0).(0) in

         let rf = Sci.shanks2_1024 ra rb.(0).(0).(0) rc.(0).(0).(0) rd.(0).(0).(0) re.(0).(0).(0) in

          z.(i) <- rf ;

          derivative_array := re.(1) ;

          j := 1 ;

          while !j < d do

           if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_sci_1024_deriv !derivative_array.( !j - 1 ) |] ;

           let essai = complex_module ( Sci.complex_of_sci ( eval_rule !derivative_array.(!j) rf ) ) in

            if essai > mult_threshold then ( accu := !j ; j := d ) ;

            j := !j + 1 ;

          done ;

          multip.(i) <- !accu ;

          j := 1 ;

   done ;

   [| [| z ; Array.map Sci.sci_of_int multip |] ; !derivative_array |] ;;






(** 
poly_wynn_1024_tune_roots eval_rule half_order threshold mult_threshold candidates polynomial
 *)


let poly_wynn_1024_tune_roots = fun eval_rule (k:int) (threshold:float) (mult_threshold:float) (candidates:Num.num array array) (p:Num.num array array) ->

 let l = Array.length candidates

 and dk = 2 * k

 and derivative_array = ref [| p ; poly_sci_deriv p |]

 and j = ref 1

 and d = int_of_float ( poly_sci_deg p ) in

  let z = Array.make l Sci.sci_0

  and kk = succ dk

  and accu = ref d

  and multip = Array.make d 1 in

   let roots = Array.make_matrix kk 1 ( Array.make_matrix 1 1 Sci.sci_0 ) in

    for i = 0 to l - 1 do

     roots.(0) <- [| [|[| candidates.(i) ; Sci.sci_1 ; Sci.sci_of_float max_float |]|] ; !derivative_array |] ;

     for index = 1 to dk do

      let racine = roots.( pred index ) in

       roots.(index) <- poly_sci_1024_tune_root_step eval_rule p racine.(1) threshold racine.(0).(0).(0) ;

     done ;

     let estimate = Sci.wynn_1024 dk 0 ( Array.map ( function x -> x.(0).(0).(0) ) roots ) in

      z.(i) <- estimate ;

      derivative_array := roots.(dk).(1) ;

      j := 1 ;

      while !j < d do

       if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_sci_1024_deriv !derivative_array.( !j - 1 ) |] ;

       let essai = complex_module ( Sci.complex_of_sci ( eval_rule !derivative_array.(!j) estimate ) ) in

        if essai > mult_threshold then ( accu := !j ; j := d ) ;

        j := !j + 1 ;

      done ;

      multip.(i) <- !accu ;

      j := 1 ;

   done ;

   [| [| z ; Array.map Sci.sci_of_int multip |] ; !derivative_array |] ;;






(** 
poly_brezinski_1024_tune_roots eval_rule half_order threshold mult_threshold candidates polynomial
 *)


let poly_brezinski_1024_tune_roots = fun eval_rule (k:int) (threshold:float) (mult_threshold:float) (candidates:Num.num array array) (p:Num.num array array) ->

 let l = Array.length candidates

 and dk = 2 * k

 and derivative_array = ref [| p ; poly_sci_deriv p |]

 and j = ref 1

 and d = int_of_float ( poly_sci_deg p ) in

  let z = Array.make l Sci.sci_0

  and kk = succ dk

  and accu = ref d

  and multip = Array.make d 1 in

   let roots = Array.make_matrix kk 1 ( Array.make_matrix 1 1 Sci.sci_0 ) in

    for i = 0 to l - 1 do

     roots.(0) <- [| [|[| candidates.(i) ; Sci.sci_1 ; Sci.sci_of_float max_float |]|] ; !derivative_array |] ;

     for index = 1 to dk do

      let racine = roots.( pred index ) in

       roots.(index) <- poly_sci_1024_tune_root_step eval_rule p racine.(1) threshold racine.(0).(0).(0) ;

     done ;

     let estimate = Sci.brezinski_1024 ( dk - 2 ) 0 ( Array.map ( function x -> x.(0).(0).(0) ) roots ) in

      z.(i) <- estimate ;

      derivative_array := roots.(dk).(1) ;

      j := 1 ;

      while !j < d do

       if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_sci_1024_deriv !derivative_array.( !j - 1 ) |] ;

       let essai = complex_module ( Sci.complex_of_sci ( eval_rule !derivative_array.(!j) estimate ) ) in

        if essai > mult_threshold then ( accu := !j ; j := d ) ;

        j := !j + 1 ;

      done ;

      multip.(i) <- !accu ;

      j := 1 ;

   done ;

   [| [| z ; Array.map Sci.sci_of_int multip |] ; !derivative_array |] ;;






(** 
poly_aitken_seki_rec_1024_tune_roots eval_rule half_order threshold mult_threshold candidates polynomial
 *)


let poly_aitken_seki_rec_1024_tune_roots = fun eval_rule (k:int) (threshold:float) (mult_threshold:float) (candidates:Num.num array array) (p:Num.num array array) ->

 let l = Array.length candidates

 and dk = 2 * k

 and derivative_array = ref [| p ; poly_sci_deriv p |]

 and j = ref 1

 and d = int_of_float ( poly_sci_deg p ) in

  let z = Array.make l Sci.sci_0

  and kk = succ dk

  and accu = ref d

  and multip = Array.make l 1 in

   let roots = Array.make_matrix kk 1 ( Array.make_matrix 1 1 Sci.sci_0 ) in

    for i = 0 to l - 1 do

     roots.(0) <- [| [|[| candidates.(i) ; Sci.sci_1 ; Sci.sci_of_float max_float |]|] ; !derivative_array |] ;

     for index = 1 to dk do

      let racine = roots.( pred index ) in

       roots.(index) <- poly_sci_1024_tune_root_step eval_rule p racine.(1) threshold racine.(0).(0).(0) ;

     done ;

     let estimate = Sci.aitken_seki_rec_1024 k 0 ( Array.map ( function x -> x.(0).(0).(0) ) roots ) in

      z.(i) <- estimate ;

      derivative_array := roots.(dk).(1) ;

      j := 1 ;

      while !j < d do

       if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_sci_1024_deriv !derivative_array.( !j - 1 ) |] ;

       let essai = complex_module ( Sci.complex_of_sci ( eval_rule !derivative_array.(!j) estimate ) ) in

        if essai > mult_threshold then ( accu := !j ; j := d ) ;

        j := !j + 1 ;

      done ;

      multip.(i) <- !accu ;

      j := 1 ;

   done ;

   [| [| z ; Array.map Sci.sci_of_int multip |] ; !derivative_array |] ;;






(** 
poly_aitken_seki_complex_tune_roots eval_rule threshold mult_threshold candidates polynomial
 *)


let poly_aitken_seki_complex_tune_roots = fun eval_rule (threshold:float) (mult_threshold:float) (candidates:float array array array) (p:float array array array) ->

 let l = Array.length candidates

 and derivative_array = ref [| p ; poly_complex_deriv p |]

 and j = ref 1

 and d = int_of_float ( poly_complex_deg p ) in

  let z = Array.make l complex_0

  and accu = ref d

  and multip = Array.make d 1 in

   for i = 0 to l - 1 do

    let ra = candidates.(i) in

     let rb = poly_complex_tune_root_step eval_rule p !derivative_array threshold ra in

      let rc = poly_complex_tune_root_step eval_rule p rb.(1) threshold rb.(0).(0).(0) in

       let rd = Matrix.matrix_float_aitken_seki ra rb.(0).(0).(0) rc.(0).(0).(0) in

        z.(i) <- rd ;

        derivative_array := rc.(1) ;

        j := 1 ;

        while !j < d do

         if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_complex_deriv !derivative_array.( !j - 1 ) |] ;

         let essai = complex_module ( eval_rule !derivative_array.(!j) rd ) in

          if essai > mult_threshold then ( accu := !j ; j := d ) ;

          j := !j + 1 ;

        done ;

        multip.(i) <- !accu ;

        j := 1 ;

   done ;

   [| [| z ; Array.map int_to_complex multip |] ; !derivative_array |] ;;






(** 
poly_wynn_complex_tune_roots eval_rule half_order threshold mult_threshold candidates polynomial
 *)


let poly_wynn_complex_tune_roots = fun eval_rule (k:int) (threshold:float) (mult_threshold:float) (candidates:float array array array) (p:float array array array) ->

 let l = Array.length candidates

 and dk = 2 * k

 and derivative_array = ref [| p ; poly_complex_deriv p |]

 and j = ref 1

 and d = int_of_float ( poly_complex_deg p ) in

  let z = Array.make l complex_0

  and kk = succ dk

  and accu = ref d

  and multip = Array.make d 1 in

   let roots = Array.make_matrix kk 1 ( Array.make_matrix 1 1 complex_0 ) in

    for i = 0 to l - 1 do

     roots.(0) <- [| [|[| candidates.(i) ; complex_1 ; float_to_complex max_float |]|] ; !derivative_array |] ;

     for index = 1 to dk do

      let racine = roots.( pred index ) in

       roots.(index) <- poly_complex_tune_root_step eval_rule p racine.(1) threshold racine.(0).(0).(0) ;

     done ;

     let estimate = Matrix.matrix_float_wynn dk 0 ( Array.map ( function x -> x.(0).(0).(0) ) roots ) in

      z.(i) <- estimate ;

      derivative_array := roots.(dk).(1) ;

      j := 1 ;

      while !j < d do

       if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_complex_deriv !derivative_array.( !j - 1 ) |] ;

       let essai = complex_module ( eval_rule !derivative_array.(!j) estimate ) in

        if essai > mult_threshold then ( accu := !j ; j := d ) ;

        j := !j + 1 ;

      done ;

      multip.(i) <- !accu ;

      j := 1 ;

   done ;

   [| [| z ; Array.map int_to_complex multip |] ; !derivative_array |] ;;






(** 
poly_brezinski_complex_tune_roots eval_rule half_order threshold mult_threshold candidates polynomial
 *)


let poly_brezinski_complex_tune_roots = fun eval_rule (k:int) (threshold:float) (mult_threshold:float) (candidates:float array array array) (p:float array array array) ->

 let l = Array.length candidates

 and dk = 2 * k

 and derivative_array = ref [| p ; poly_complex_deriv p |]

 and j = ref 1

 and d = int_of_float ( poly_complex_deg p ) in

  let z = Array.make l complex_0

  and kk = succ dk

  and accu = ref d

  and multip = Array.make d 1 in

   let roots = Array.make_matrix kk 1 ( Array.make_matrix 1 1 complex_0 ) in

    for i = 0 to l - 1 do

     roots.(0) <- [| [|[| candidates.(i) ; complex_1 ; float_to_complex max_float |]|] ; !derivative_array |] ;

     for index = 1 to dk do

      let racine = roots.( pred index ) in

       roots.(index) <- poly_complex_tune_root_step eval_rule p racine.(1) threshold racine.(0).(0).(0) ;

     done ;

     let estimate = Matrix.matrix_float_brezinski ( dk - 2 ) 0 ( Array.map ( function x -> x.(0).(0).(0) ) roots ) in

      z.(i) <- estimate ;

      derivative_array := roots.(dk).(1) ;

      j := 1 ;

      while !j < d do

       if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_complex_deriv !derivative_array.( !j - 1 ) |] ;

       let essai = complex_module ( eval_rule !derivative_array.(!j) estimate ) in

        if essai > mult_threshold then ( accu := !j ; j := d ) ;

        j := !j + 1 ;

      done ;

      multip.(i) <- !accu ;

      j := 1 ;

   done ;

   [| [| z ; Array.map int_to_complex multip |] ; !derivative_array |] ;;






(** 
poly_aitken_seki_rec_complex_tune_roots eval_rule half_order threshold mult_threshold candidates polynomial
 *)


let poly_aitken_seki_rec_complex_tune_roots = fun eval_rule (k:int) (threshold:float) (mult_threshold:float) (candidates:float array array array) (p:float array array array) ->

 let l = Array.length candidates

 and dk = 2 * k

 and derivative_array = ref [| p ; poly_complex_deriv p |]

 and j = ref 1

 and d = int_of_float ( poly_complex_deg p ) in

  let z = Array.make l complex_0

  and kk = succ dk

  and accu = ref d

  and multip = Array.make l 1 in

   let roots = Array.make_matrix kk 1 ( Array.make_matrix 1 1 complex_0 ) in

    for i = 0 to l - 1 do

     roots.(0) <- [| [|[| candidates.(i) ; complex_1 ; float_to_complex max_float |]|] ; !derivative_array |] ;

     for index = 1 to dk do

      let racine = roots.( pred index ) in

       roots.(index) <- poly_complex_tune_root_step eval_rule p racine.(1) threshold racine.(0).(0).(0) ;

     done ;

     let estimate = Matrix.matrix_float_aitken_seki_rec k 0 ( Array.map ( function x -> x.(0).(0).(0) ) roots ) in

      z.(i) <- estimate ;

      derivative_array := roots.(dk).(1) ;

      j := 1 ;

      while !j < d do

       if Array.length !derivative_array = !j then derivative_array := Array.append !derivative_array [| poly_complex_deriv !derivative_array.( !j - 1 ) |] ;

       let essai = complex_module ( eval_rule !derivative_array.(!j) estimate ) in

        if essai > mult_threshold then ( accu := !j ; j := d ) ;

        j := !j + 1 ;

      done ;

      multip.(i) <- !accu ;

      j := 1 ;

   done ;

   [| [| z ; Array.map int_to_complex multip |] ; !derivative_array |] ;;






(** 
simple_complex_roots eval_rule stages_spectrum stages_roots steps threshold polynomial
 *)


let rec simple_complex_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (p:float array array array) ->

 let d = poly_complex_deg p in

  if d = neg_infinity then failwith "Null polynomial in Reduc.simple_complex_roots." ;

  match d with

  | 0. -> failwith "Nonzero constant polynomial in Reduc.simple_complex_roots."

  | 1. ->

   begin

    let s = complex_div p.(0) p.(1) in

     [| Matrix.matrix_float_opp s |]

   end

  | 2. -> complex_solve_degree_2 p.(2) p.(1) p.(0)

  | _ ->

   begin

    let m = complex_companion p in

     let s = clean_complex_spectrum stages_spectrum steps m in

      let res = poly_aitken_seki_rec_complex_tune_roots eval_rule stages_roots threshold 1. [| s.(0) |] p in

       let a = res.(0).(0).(0) in

        let q = ( poly_complex_div p ( poly_complex_x_a a ) ).(0) in

         Array.append [| a |] ( simple_complex_roots eval_rule stages_spectrum stages_roots steps threshold q )

   end ;;






(** 
maehly_complex_step eval_rule roots polynomial derivative value
 The algorithm is described at the following address.



www.cs.iastate.edu/~cs577/handouts/polyroots.pdf



L'algorithme est décrit à l'adresse précédente. *)


let maehly_complex_step = fun eval_rule (r:float array array array) (p:float array array array) (der_p:float array array array) (x:float array array) ->

 let vector = Array.map ( Matrix.matrix_float_minus x ) r

 and numerator = eval_rule p x

 and init = Matrix.matrix_float_opp ( eval_rule der_p x ) in

  let other_vector = Array.map ( complex_div numerator ) vector in

   let denominator = Array.fold_left Matrix.matrix_float_plus init other_vector in

    let fraction = complex_div numerator denominator in

     Matrix.matrix_float_plus x fraction ;;




(** 
simple_maehly_complex_roots mult_rule eval_rule stages_spectrum stages_roots steps threshold roots polynomial derivative
 *)


let rec simple_maehly_complex_roots = fun mult_rule eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (r:float array array array) (p:float array array array) (der_p:float array array array) ->

 let d = poly_complex_deg p

 and n = float ( Array.length r ) in

  if d = neg_infinity then failwith "Null polynomial in Reduc.simple_maehly_complex_roots." ;

  let dd = d -. n in

   if dd < 0. then failwith "Too much roots in Reduc.simple_maehly_complex_roots." ;

   match dd with

   | 0. -> r

   | 1. ->

    begin

     let q = ( poly_complex_div p ( poly_complex_from_roots mult_rule r ) ).(0) in

      let s = complex_div q.(0) q.(1) in

       Array.append r [| Matrix.matrix_float_opp s |]

    end

   | 2. ->

    begin

     let q = ( poly_complex_div p ( poly_complex_from_roots mult_rule r ) ).(0) in

      Array.append r ( complex_solve_degree_2 q.(2) q.(1) q.(0) )

    end

   | _ ->

    begin

     let q = if Array.length r > 0 then ( poly_complex_div p ( poly_complex_from_roots mult_rule r ) ).(0) else p in

      let m = complex_companion q in

       let s =

        begin

         try

          begin

           let u = matrix_unitary_random ( pred ( Array.length p ) ) 1. in

            let v = Matrix.matrix_float_twisted_prod u m in

             let w = Matrix.matrix_float_twisted_prod u v in

              clean_complex_spectrum stages_spectrum steps w

          end

         with _ ->

          clean_complex_spectrum stages_spectrum steps m

        end in

        let res = poly_aitken_seki_rec_complex_tune_roots eval_rule stages_roots threshold 1. [| s.(0) |] q in

         let a = ref res.(0).(0).(0) in

          let error = ref ( complex_abs_sum ( eval_rule p !a ) ) in

           while !error > threshold do

            a := maehly_complex_step eval_rule r p der_p !a ;

            error := complex_abs_sum ( eval_rule p !a ) ;

           done ;

           simple_maehly_complex_roots mult_rule eval_rule stages_spectrum stages_roots steps threshold ( Array.append r [| !a |] ) p der_p

    end ;;




(** 
simple_sci_1024_roots eval_rule stages_spectrum stages_roots steps threshold polynomial
 *)


let rec simple_sci_1024_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (p:Num.num array array) ->

 let d = poly_sci_deg p in

  if d = neg_infinity then failwith "Null polynomial in Reduc.simple_sci_1024_roots." ;

  match d with

  | 0. -> failwith "Nonzero constant polynomial in Reduc.simple_sci_1024_roots."

  | 1. ->

   begin

    let s = Sci.div_1024 p.(0) p.(1) in

     [| Sci.opp s |]

   end

  | 2. -> Sci.solve_degree_2_1024 p.(2) p.(1) p.(0)

  | 3. -> Sci.solve_degree_3_1024 p.(3) p.(2) p.(1) p.(0)

  | 4. -> Sci.solve_degree_4_1024 p.(4) p.(3) p.(2) p.(1) p.(0)

  | _ ->

   begin

    let pp = poly_sci_to_complex p in

     let m = complex_companion pp in

      let s = clean_complex_spectrum stages_spectrum steps m in

       let res = poly_aitken_seki_rec_1024_tune_roots eval_rule stages_roots threshold 1. [| Sci.sci_of_complex s.(0) |] p in

        let a = res.(0).(0).(0) in

         let q = ( poly_sci_1024_div p ( poly_sci_x_a a ) ).(0) in

          Array.append [| a |] ( simple_sci_1024_roots eval_rule stages_spectrum stages_roots steps threshold q )

   end ;;






(** 
maehly_sci_1024_step eval_rule roots polynomial derivative value
 The algorithm is described at the following address.



www.cs.iastate.edu/~cs577/handouts/polyroots.pdf



L'algorithme est décrit à l'adresse précédente. *)


let maehly_sci_1024_step = fun eval_rule (r:Num.num array array) (p:Num.num array array) (der_p:Num.num array array) (x:Num.num array) ->

 let vector = Array.map ( Sci.minus_1024 x ) r

 and numerator = eval_rule p x

 and init = Sci.opp ( eval_rule der_p x ) in

  let other_vector = Array.map ( Sci.div_1024 numerator ) vector in

   let denominator = Array.fold_left Sci.plus_1024 init other_vector in

    let fraction = Sci.div_1024 numerator denominator in

     Sci.plus_1024 x fraction ;;




(** 
simple_maehly_sci_1024_roots mult_rule eval_rule stages_spectrum stages_roots steps threshold roots polynomial derivative
 *)


let rec simple_maehly_sci_1024_roots = fun mult_rule eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (r:Num.num array array) (p:Num.num array array) (der_p:Num.num array array) ->

 let d = poly_sci_deg p

 and n = float ( Array.length r ) in

  if d = neg_infinity then failwith "Null polynomial in Reduc.simple_maehly_sci_1024_roots." ;

  let dd = d -. n in

   if dd < 0. then failwith "Too much roots in Reduc.simple_maehly_sci_1024_roots." ;

   match dd with

   | 0. -> r

   | 1. ->

    begin

     let q = ( poly_sci_1024_div p ( poly_sci_1024_from_roots mult_rule r ) ).(0) in

      let s = Sci.div_1024 q.(0) q.(1) in

       Array.append r [| Sci.opp s |]

    end

   | 2. ->

    begin

     let q = ( poly_sci_1024_div p ( poly_sci_1024_from_roots mult_rule r ) ).(0) in

      Array.append r ( Sci.solve_degree_2_1024 q.(2) q.(1) q.(0) )

    end

   | 3. ->

    begin

     let q = ( poly_sci_1024_div p ( poly_sci_1024_from_roots mult_rule r ) ).(0) in

      Array.append r ( Sci.solve_degree_3_1024 q.(3) q.(2) q.(1) q.(0) )

    end

   | 4. ->

    begin

     let q = ( poly_sci_1024_div p ( poly_sci_1024_from_roots mult_rule r ) ).(0) in

      Array.append r ( Sci.solve_degree_4_1024 q.(4) q.(3) q.(2) q.(1) q.(0) )

    end

   | _ ->

    begin

     let q = if Array.length r > 0 then ( poly_sci_1024_div p ( poly_sci_1024_from_roots mult_rule r ) ).(0) else p in

      let qq = Array.map Sci.complex_of_sci q in

       let m = complex_companion qq in

        let s =

         begin

          try

           begin

            let u = matrix_unitary_random ( pred ( Array.length p ) ) 1. in

             let v = Matrix.matrix_float_twisted_prod u m in

              let w = Matrix.matrix_float_twisted_prod u v in

               clean_complex_spectrum stages_spectrum steps w

           end

          with _ ->

           clean_complex_spectrum stages_spectrum steps m

         end in

         let res = poly_aitken_seki_rec_1024_tune_roots eval_rule stages_roots threshold 1. [| Sci.sci_of_complex s.(0) |] q in

          let a = ref res.(0).(0).(0) in

           let error = ref ( complex_abs_sum ( Sci.complex_of_sci ( eval_rule p !a ) ) ) in

            while !error > threshold do

             a := maehly_sci_1024_step eval_rule r p der_p !a ;

             error := complex_abs_sum ( Sci.complex_of_sci ( eval_rule p !a ) ) ;

            done ;

            simple_maehly_sci_1024_roots mult_rule eval_rule stages_spectrum stages_roots steps threshold ( Array.append r [| !a |] ) p der_p

    end ;;






(** 
largo_simple_complex_roots eval_rule stages_spectrum stages_roots steps threshold polynomial
 *)


let largo_simple_complex_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (p:float array array array) ->

 let r = simple_sci_1024_roots eval_rule stages_spectrum stages_roots steps threshold ( poly_complex_to_sci p ) in

  poly_sci_to_complex r ;;






(** 
largo_simple_maehly_complex_roots mult_rule eval_rule stages_spectrum stages_roots steps threshold polynomial
 *)


let largo_simple_maehly_complex_roots = fun mult_rule eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (p:float array array array) ->

 let pp = poly_complex_to_sci p in

  let r = simple_maehly_sci_1024_roots mult_rule eval_rule stages_spectrum stages_roots steps threshold [| |] pp ( poly_sci_1024_deriv pp ) in

   poly_sci_to_complex r ;;






(** 
simple_direct_complex_roots eval_rule stages_roots steps threshold_qr threshold polynomial
 *)


let rec simple_direct_complex_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (p:float array array array) ->

 let d = poly_complex_deg p in

  if d = neg_infinity then failwith "Null polynomial in Reduc.simple_direct_complex_roots." ;

  match d with

  | 0. -> failwith "Nonzero constant polynomial in Reduc.simple_direct_complex_roots."

  | 1. ->

   begin

    let s = complex_div p.(0) p.(1) in

     [| Matrix.matrix_float_opp s |]

   end

  | 2. -> complex_solve_degree_2 p.(2) p.(1) p.(0)

  | _ ->

   begin

    let m = complex_companion p in

     let s = direct_complex_spectrum threshold_qr threshold steps steps m in

      let res = poly_aitken_seki_rec_complex_tune_roots eval_rule stages_roots threshold 1. [| s.(0) |] p in

       let a = res.(0).(0).(0) in

        let q = ( poly_complex_div p ( poly_complex_x_a a ) ).(0) in

         Array.append [| a |] ( simple_direct_complex_roots eval_rule stages_roots steps threshold_qr threshold q )

   end ;;






(** 
simple_direct_sci_1024_roots eval_rule stages_roots steps threshold_qr threshold polynomial
 *)


let rec simple_direct_sci_1024_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (p:Num.num array array) ->

 let d = poly_sci_deg p in

  if d = neg_infinity then failwith "Null polynomial in Reduc.simple_direct_sci_1024_roots." ;

  match d with

  | 0. -> failwith "Nonzero constant polynomial in Reduc.simple_direct_sci_1024_roots."

  | 1. ->

   begin

    let s = Sci.div_1024 p.(0) p.(1) in

     [| Sci.opp s |]

   end

  | 2. -> Sci.solve_degree_2_1024 p.(2) p.(1) p.(0)

  | 3. -> Sci.solve_degree_3_1024 p.(3) p.(2) p.(1) p.(0)

  | 4. -> Sci.solve_degree_4_1024 p.(4) p.(3) p.(2) p.(1) p.(0)

  | _ ->

   begin

    let pp = poly_sci_to_complex p in

     let m = complex_companion pp in

      let s = direct_complex_spectrum threshold_qr threshold steps steps m in

       let res = poly_aitken_seki_rec_1024_tune_roots eval_rule stages_roots threshold 1. [| Sci.sci_of_complex s.(0) |] p in

        let a = res.(0).(0).(0) in

         let q = ( poly_sci_1024_div p ( poly_sci_x_a a ) ).(0) in

          Array.append [| a |] ( simple_direct_sci_1024_roots eval_rule stages_roots steps threshold_qr threshold q )

   end ;;






(** 
largo_simple_direct_complex_roots eval_rule stages_roots steps threshold_qr threshold polynomial
 *)


let largo_simple_direct_complex_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (p:float array array array) ->

 let r = simple_direct_sci_1024_roots eval_rule stages_roots steps threshold_qr threshold ( poly_complex_to_sci p ) in

  poly_sci_to_complex r ;;






(** 
naive_complex_roots eval_rule stages_spectrum stages_roots steps threshold mult_threshold polynomial
 *)


let naive_complex_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (mult_threshold:float) (p:float array array array) ->

 let q = poly_complex_simplify p in

  let s = simple_complex_roots eval_rule stages_spectrum stages_roots steps threshold q in

   let res = poly_aitken_seki_rec_complex_tune_roots eval_rule stages_roots threshold mult_threshold s p in

    res.(0) ;;






(** 
complex_maehly_roots mult_rule eval_rule stages_spectrum stages_roots steps threshold mult_threshold polynomial
 *)


let complex_maehly_roots = fun mult_rule eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (mult_threshold:float) (p:float array array array) ->

 let q = poly_complex_simplify p in

  let s = simple_maehly_complex_roots mult_rule eval_rule stages_spectrum stages_roots steps threshold [| |] q ( poly_complex_deriv q ) in

   let res = poly_aitken_seki_rec_complex_tune_roots eval_rule stages_roots threshold mult_threshold s p in

    res.(0) ;;






(** 
direct_complex_roots eval_rule stages_roots steps threshold_qr threshold mult_threshold polynomial
 *)


let direct_complex_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (mult_threshold:float) (p:float array array array) ->

 let s = simple_direct_complex_roots eval_rule stages_roots steps threshold_qr threshold p in

  let res = poly_aitken_seki_rec_complex_tune_roots eval_rule stages_roots threshold mult_threshold s p in

   res.(0) ;;






(** 
naive_sci_1024_roots eval_rule stages_spectrum stages_roots steps threshold mult_threshold polynomial
 *)


let naive_sci_1024_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (mult_threshold:float) (p:Num.num array array) ->

 let q = poly_sci_1024_simplify p in

  let s = simple_sci_1024_roots eval_rule stages_spectrum stages_roots steps threshold q in

   let res = poly_aitken_seki_rec_1024_tune_roots eval_rule stages_roots threshold mult_threshold s p in

    res.(0) ;;






(** 
sci_1024_maehly_roots mult_rule eval_rule stages_spectrum stages_roots steps threshold mult_threshold polynomial
 *)


let sci_1024_maehly_roots = fun mult_rule eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (mult_threshold:float) (p:Num.num array array) ->

 let q = poly_sci_1024_simplify p in

  let s = simple_maehly_sci_1024_roots mult_rule eval_rule stages_spectrum stages_roots steps threshold [| |] q ( poly_sci_1024_deriv q ) in

   let res = poly_aitken_seki_rec_1024_tune_roots eval_rule stages_roots threshold mult_threshold s p in

    res.(0) ;;






(** 
direct_sci_1024_roots eval_rule stages_roots steps threshold_qr threshold mult_threshold polynomial
 *)


let direct_sci_1024_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (mult_threshold:float) (p:Num.num array array) ->

 let s = simple_direct_sci_1024_roots eval_rule stages_roots steps threshold_qr threshold p in

  let res = poly_aitken_seki_rec_1024_tune_roots eval_rule stages_roots threshold mult_threshold s p in

   res.(0) ;;






(** 
largo_naive_complex_roots eval_rule stages_spectrum stages_roots steps threshold mult_threshold polynomial
 *)


let largo_naive_complex_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (mult_threshold:float) (p:float array array array) ->

 let r = naive_sci_1024_roots eval_rule stages_spectrum stages_roots steps threshold mult_threshold ( poly_complex_to_sci p ) in

  Array.map poly_sci_to_complex r ;;






(** 
largo_direct_complex_roots eval_rule stages_roots steps threshold_qr threshold mult_threshold polynomial
 *)


let largo_direct_complex_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (mult_threshold:float) (p:float array array array) ->

 let r = direct_sci_1024_roots eval_rule stages_roots steps threshold_qr threshold mult_threshold ( poly_complex_to_sci p ) in

  Array.map poly_sci_to_complex r ;;






(** 
simple_complex_shifted_roots eval_rule stages_spectrum stages_roots steps threshold shift polynomial
 *)


let rec simple_complex_shifted_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (shift:float array array) (p:float array array array) ->

 let d = poly_complex_deg p in

  if d = neg_infinity then failwith "Null polynomial in Reduc.simple_complex_shifted_roots." ;

  match d with

  | 0. -> failwith "Nonzero constant polynomial in Reduc.simple_complex_shifted_roots."

  | 1. ->

   begin

    let s = complex_div p.(0) p.(1) in

     [| Matrix.matrix_float_opp s |]

   end

  | 2. -> complex_solve_degree_2 p.(2) p.(1) p.(0)

  | _ ->

   begin

    let m = complex_companion p in

     let s = clean_complex_shifted_spectrum stages_spectrum steps shift m in

      let res = poly_aitken_seki_rec_complex_tune_roots eval_rule stages_roots threshold 1. [| s.(0) |] p in

        let a = res.(0).(0).(0) in

         let q = ( poly_complex_div p ( poly_complex_x_a a ) ).(0) in

          Array.append [| a |] ( simple_complex_shifted_roots eval_rule stages_spectrum stages_roots steps threshold shift q )

   end ;;






(** 
simple_sci_1024_shifted_roots eval_rule stages_spectrum stages_roots steps threshold shift polynomial
 *)


let rec simple_sci_1024_shifted_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (shift:float array array) (p:Num.num array array) ->

 let d = poly_sci_deg p in

  if d = neg_infinity then failwith "Null polynomial in Reduc.simple_sci_1024_shifted_roots." ;

  match d with

  | 0. -> failwith "Nonzero constant polynomial in Reduc.simple_sci_1024_shifted_roots."

  | 1. ->

   begin

    let s = Sci.div_1024 p.(0) p.(1) in

     [| Sci.opp s |]

   end

  | 2. -> Sci.solve_degree_2_1024 p.(2) p.(1) p.(0)

  | 3. -> Sci.solve_degree_3_1024 p.(3) p.(2) p.(1) p.(0)

  | 4. -> Sci.solve_degree_4_1024 p.(4) p.(3) p.(2) p.(1) p.(0)

  | _ ->

   begin

    let pp = poly_sci_to_complex p in

     let m = complex_companion pp in

      let s = clean_complex_shifted_spectrum stages_spectrum steps shift m in

       let res = poly_aitken_seki_rec_1024_tune_roots eval_rule stages_roots threshold 1. [| Sci.sci_of_complex s.(0) |] p in

        let a = res.(0).(0).(0) in

         let q = ( poly_sci_1024_div p ( poly_sci_x_a a ) ).(0) in

          Array.append [| a |] ( simple_sci_1024_shifted_roots eval_rule stages_spectrum stages_roots steps threshold shift q )

   end ;;






(** 
largo_simple_complex_shifted_roots eval_rule stages_spectrum stages_roots steps threshold shift polynomial
 *)


let rec largo_simple_complex_shifted_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (shift:float array array) (p:float array array array) ->

 let r = simple_sci_1024_shifted_roots eval_rule stages_spectrum stages_roots steps threshold shift ( poly_complex_to_sci p ) in

  poly_sci_to_complex r ;;






(** 
simple_direct_complex_shifted_roots eval_rule stages_roots steps threshold_qr threshold shift polynomial
 *)


let rec simple_direct_complex_shifted_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (shift:float array array) (p:float array array array) ->

 let d = poly_complex_deg p in

  if d = neg_infinity then failwith "Null polynomial in Reduc.simple_direct_complex_shifted_roots." ;

  match d with

  | 0. -> failwith "Nonzero constant polynomial in Reduc.simple_direct_complex_shifted_roots."

  | 1. ->

   begin

    let s = complex_div p.(0) p.(1) in

     [| Matrix.matrix_float_opp s |]

   end

  | 2. -> complex_solve_degree_2 p.(2) p.(1) p.(0)

  | _ ->

   begin

    let m = complex_companion p in

     let s = direct_complex_shifted_spectrum threshold_qr threshold steps steps shift m in

      let res = poly_aitken_seki_rec_complex_tune_roots eval_rule stages_roots threshold 1. [| s.(0) |] p in

       let a = res.(0).(0).(0) in

        let q = ( poly_complex_div p ( poly_complex_x_a a ) ).(0) in

         Array.append [| a |] ( simple_direct_complex_shifted_roots eval_rule stages_roots steps threshold_qr threshold shift q )

   end ;;






(** 
simple_direct_sci_1024_shifted_roots eval_rule stages_roots steps threshold_qr threshold shift polynomial
 *)


let rec simple_direct_sci_1024_shifted_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (shift:float array array) (p:Num.num array array) ->

 let d = poly_sci_deg p in

  if d = neg_infinity then failwith "Null polynomial in Reduc.simple_direct_sci_1024_shifted_roots." ;

  match d with

  | 0. -> failwith "Nonzero constant polynomial in Reduc.simple_direct_sci_1024_shifted_roots."

  | 1. ->

   begin

    let s = Sci.div_1024 p.(0) p.(1) in

     [| Sci.opp s |]

   end

  | 2. -> Sci.solve_degree_2_1024 p.(2) p.(1) p.(0)

  | 3. -> Sci.solve_degree_3_1024 p.(3) p.(2) p.(1) p.(0)

  | 4. -> Sci.solve_degree_4_1024 p.(4) p.(3) p.(2) p.(1) p.(0)

  | _ ->

   begin

    let pp = poly_sci_to_complex p in

     let m = complex_companion pp in

      let s = direct_complex_shifted_spectrum threshold_qr threshold steps steps shift m in

       let res = poly_aitken_seki_rec_1024_tune_roots eval_rule stages_roots threshold 1. [| Sci.sci_of_complex s.(0) |] p in

        let a = res.(0).(0).(0) in

         let q = ( poly_sci_1024_div p ( poly_sci_x_a a ) ).(0) in

          Array.append [| a |] ( simple_direct_sci_1024_shifted_roots eval_rule stages_roots steps threshold_qr threshold shift q )

   end ;;






(** 
largo_simple_direct_complex_shifted_roots eval_rule stages_roots steps threshold_qr threshold shift polynomial
 *)


let largo_simple_direct_complex_shifted_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (shift:float array array) (p:float array array array) ->

 let r = simple_direct_sci_1024_shifted_roots eval_rule stages_roots steps threshold_qr threshold shift ( poly_complex_to_sci p ) in

  poly_sci_to_complex r ;;






(** 
complex_shifted_roots eval_rule stages_spectrum stages_roots steps threshold mult_threshold shift polynomial
 *)


let complex_shifted_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (mult_threshold:float) (shift:float array array) (p:float array array array) ->

 let q = poly_complex_simplify p in

  let s = simple_complex_shifted_roots eval_rule stages_spectrum stages_roots steps threshold shift q in

   let res = poly_aitken_seki_rec_complex_tune_roots eval_rule stages_roots threshold mult_threshold s p in

    res.(0) ;;






(** 
sci_1024_shifted_roots eval_rule stages_spectrum stages_roots steps threshold mult_threshold shift polynomial
 *)


let sci_1024_shifted_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (mult_threshold:float) (shift:float array array) (p:Num.num array array) ->

 let q = poly_sci_1024_simplify p in

  let s = simple_sci_1024_shifted_roots eval_rule stages_spectrum stages_roots steps threshold shift q in

   let res = poly_aitken_seki_rec_1024_tune_roots eval_rule stages_roots threshold mult_threshold s p in

    res.(0) ;;






(** 
direct_complex_shifted_roots eval_rule stages_roots steps threshold_qr threshold mult_threshold shift polynomial
 *)


let direct_complex_shifted_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (mult_threshold:float) (shift:float array array) (p:float array array array) ->

 let s = simple_direct_complex_shifted_roots eval_rule stages_roots steps threshold_qr threshold shift p in

  let res = poly_aitken_seki_rec_complex_tune_roots eval_rule stages_roots threshold mult_threshold s p in

   res.(0) ;;






(** 
direct_sci_1024_shifted_roots eval_rule stages_roots steps threshold_qr threshold mult_threshold shift polynomial
 *)


let direct_sci_1024_shifted_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (mult_threshold:float) (shift:float array array) (p:Num.num array array) ->

 let s = simple_direct_sci_1024_shifted_roots eval_rule stages_roots steps threshold_qr threshold shift p in

  let res = poly_aitken_seki_rec_1024_tune_roots eval_rule stages_roots threshold mult_threshold s p in

   res.(0) ;;






(** 
largo_complex_shifted_roots eval_rule stages_spectrum stages_roots steps threshold mult_threshold shift polynomial
 *)


let largo_complex_shifted_roots = fun eval_rule (stages_spectrum:int) (stages_roots:int) (steps:int) (threshold:float) (mult_threshold:float) (shift:float array array) (p:float array array array) ->

 let r = sci_1024_shifted_roots eval_rule stages_spectrum stages_roots steps threshold mult_threshold shift ( poly_complex_to_sci p ) in

  Array.map poly_sci_to_complex r ;;






(** 
largo_direct_complex_shifted_roots eval_rule stages_roots steps threshold_qr threshold mult_threshold shift polynomial
 *)


let largo_direct_complex_shifted_roots = fun eval_rule (stages_roots:int) (steps:int) (threshold_qr:float) (threshold:float) (mult_threshold:float) (shift:float array array) (p:float array array array) ->

 let r = direct_sci_1024_shifted_roots eval_rule stages_roots steps threshold_qr threshold mult_threshold shift ( poly_complex_to_sci p ) in

  Array.map poly_sci_to_complex r ;;






(** 
complex_roots threshold polynomial
 *)


let complex_roots = fun (threshold:float) (p:float array array array) ->

 let mr = poly_complex_mult

 and er = poly_complex_evaluate poly_complex_horner_comp in

  ( complex_maehly_roots mr er 2 0 100 threshold 1. p ).(0) ;;




(** 
sci_1024_roots threshold polynomial
 *)


let sci_1024_roots = fun (threshold:float) (p:Num.num array array) ->

 let mr = poly_sci_1024_mult

 and er = poly_sci_1024_evaluate poly_sci_1024_horner_comp in

  ( sci_1024_maehly_roots mr er 2 0 100 threshold 1. p ).(0) ;;




(** 
largo_complex_roots threshold polynomial
 *)


let largo_complex_roots = fun (threshold:float) (p:float array array array) ->

 let mr = poly_sci_1024_mult

 and er = poly_sci_1024_evaluate poly_sci_1024_horner_comp in

  let r = ( sci_1024_maehly_roots mr er 2 0 100 threshold 1. ( poly_complex_to_sci p ) ).(0) in

   poly_sci_to_complex r ;;






(** 
complex_diagonalization methode_ker threshold_qr threshold steps_qr steps_power methode_tune_roots char_pol matrix
 
The matrix is supposed to be diagonalizable.
The first number of steps steps_qr is the one used in
the QR algorithm of Francis ; the second steps is the one used in the inverse iteration.
The method methode_ker may be the one used to search for a kernel with the singular value decomposition.
In the case when the matrix is not simple, the passage matrix has few precision.
The output is the same as for direct_complex_diagonalization.



La sortie est la même que pour direct_complex_diagonalization.
La matrice est supposée diagonalisable.
Le premier nombre maximal de pas steps_qr est celui utilisé pour l'algorithme QR de Francis ;
le deuxième steps est celui utilisé dans l'itération inverse.
La méthode methode_ker peut être celle utilisée pour rechercher un noyau avec la décomposition en valeurs singulières.
Dans le cas où la matrice n'est pas simple, la matrice de passage est peu précise. *)


let complex_diagonalization = fun methode_ker (threshold_qr:float) (threshold:float) (steps_qr:int) (steps:int) methode_tune_roots (char_pol:float array array array) (m:float array array) ->

 let res = complex_francis_schur_decomposition threshold_qr threshold steps_qr m

 and seuil = sqrt epsilon_float

 and nn = Array.length m

 and accu_integer = ref 0

 and accu_complex = ref complex_0 in

  let pp = Array.map clean_complex ( matrix_complex_extract_diag_to_poly res.(0) )

  and q = Matrix.float_transpose res.(1)

  and n = nn / 2 in

   let spectrum = Array.make n complex_0

   and ppp = methode_tune_roots pp char_pol

   and n_n = n - 1

   and trans_passage = Array.make_matrix nn nn 0. in

    let p = ppp.(0).(0) in

     for i = 0 to n_n do

      let candidate_value = p.(i) in

       let difference = Matrix.matrix_float_minus m ( scal_complex n n candidate_value ) in

        let test = Matrix.float_invertibility difference in

         if test then

          begin

           let mm = Matrix.clean_inv difference in

            let w = Matrix.float_normalized_iterate Matrix.vector_float_norm_2 steps mm q.(i) in

             trans_passage.(i) <- Matrix.vector_float_copy w ;

             trans_passage.( n + i ) <- vector_complex_i_times w ;

             let ww = Matrix.matrix_vector_float_prod mm w

             and z = complex_vector_to_complex_poly w in

              let zz = complex_vector_to_complex_poly ww in

               for j = 0 to n_n do

                let divisor = z.(j) in

                 if complex_module divisor > seuil then

                  begin

                   accu_complex := Matrix.matrix_float_plus !accu_complex ( Matrix.matrix_float_prod zz.(j) ( complex_inv divisor ) ) ;

                   accu_integer := succ !accu_integer ;

                  end ;

               done ;

               let coeff = clean_complex ( Matrix.matrix_float_scal_left_div ( float !accu_integer ) !accu_complex ) in

                accu_complex := complex_0 ;

                accu_integer := 0 ;

                spectrum.(i) <- Matrix.matrix_float_plus candidate_value ( complex_inv coeff ) ;

          end

         else

          begin

           spectrum.(i) <- candidate_value ;

           let k = methode_ker difference in

            let kk = Array.length k in

             let v = Matrix.vector_float_bal_random kk 10. in

              let w_w = ( Matrix.matrix_vector_float_prod ( Matrix.float_transpose k ) ( Matrix.vector_float_scal_mult ( 1. /. ( Matrix.vector_float_norm_2 v ) ) v ) ) in

               let w_coeff = 1. /. ( Matrix.vector_float_norm_2 w_w ) in

                let w = Matrix.vector_float_scal_mult w_coeff w_w in

                 trans_passage.(i) <- Matrix.vector_float_copy w ;

                 trans_passage.( n + i ) <- vector_complex_i_times w ;

          end ;

     done ;

     [| spectrum ; [| Matrix.float_transpose trans_passage |] ; [| trans_passage  |] |] ;; 






(** 
demultip roots_and_multiplicity_array
 Input : roots; multiplicities.
Output : roots counted with respect to their multiplicities.



Entrée : racines ; multiplicités.
Sortie : racines comptées avec leur multiplicité. *)


let demultip = function (r:float array array array array) ->

 let roots = r.(0)

 and multiplicities = r.(1)

 and s = ref [||] in

  let l = Array.length roots in

   for i = 0 to pred l do

    for j = 1 to int_of_float ( complex_real_part multiplicities.(i) ) do

     s := Array.append !s [| roots.(i) |]

    done ;

   done ;

   !s ;;






(** 
complex_det spectrum_method matrix
 *)


let complex_det = fun spectrum_methode (m:float array array) ->

 let p = spectrum_methode m in

  vector_complex_contraction p ;;




(** 
gauss_det spectrum_method matrix
 *)


let gauss_det = fun spectrum_methode (m:int array array) ->

 let mm = Array.map ( Array.map float ) m in

  let p = spectrum_methode mm in

   Matrix.matrix_float_round ( vector_complex_contraction p ) ;;






(** 
complex_krylov_reduction apply_rule decomposition_polynomial methode_diag matrix
 Output: conjugate matrix (in the eigenbasis), 
matrix whose columns are the respective eigenvectors of the diagonalizable part, inverse of the preceding matrix, 
candidate for the diagonal matrix, conjugate matrix of the nilpotent part (in the eigenbasis), matrix whose rows are the eigenvectors of the diagonalizable part.



Sortie : matrice conjuguée (dans la base propre), matrice dont les colonnes sont les vecteurs propres de la partie diagonalisable, 
matrice inverse de la précédente, candidat pour la matrice diagonale, matrice conjuguée de la partie nilpotente (dans la base propre), 
matrice dont les lignes sont les vecteurs propres de la partie diagonalisable. *)


let complex_krylov_reduction = fun apply_rule (decomposition_polynomial:float array array array) methode_diag (m:float array array) ->

 let dec = jordan_decomposition apply_rule decomposition_polynomial m in

  let d = dec.(0)

  and n = dec.(1) in

   let dd = methode_diag d in

    let p = dd.(1).(0)

    and ddd = diag_complex dd.(0) in

     let q = Matrix.clean_inv p in

      let nn = Matrix.matrix_float_triple_prod q n p in

       [| Matrix.matrix_float_plus nn ddd ; p ; q ; ddd ; nn ; dd.(2).(0) |] ;;




























(** 
§ § § 
 *)










end ;;











module Data2 = struct










(** 
§ 
 *)



(** 

Introduction

*)



(** 
 
 *)











(**
The mathematician will find in this module algebraic structures to use in the modules sparse_vector.ml, sparse_tensor.ml, sparse_matrix.ml, mat.ml, fft.ml as coefficients.



This module is distributed under the same licence as Ocaml.




§ 




La mathématicienne ou le mathématicien trouvera dans ce module des structures algébriques à utiliser dans les modules sparse_vector.ml, sparse_tensor.ml, sparse_matrix.ml, mat.ml, fft.ml comme coefficients.



Ce module est distribué selon la même licence qu'Ocaml.




Copyright Stéphane Grognet 


Laboratoire de mathématiques Jean Leray UMR 6629 CNRS 


Fédération de recherche mathématique des Pays de la Loire 


IREM des Pays de la Loire - Université de Nantes 


version 0.2

*)



(**
@version 0.2
*)



(**
@author Stéphane Grognet
*)



(**
@since 2012, 2013
*)










open Util ;;

open Data ;;

open Matrix ;;

open Sci ;;

open Reduc ;;









module C_coeff = struct



type t = float array array ;;

type u = float ;;

let norm_inject = function (x:u) -> ([| [| x ; 0. |] ; [| 0. ; x |] |]:t) ;;

let norm_zero = function () -> 0. ;;

let norm_of_string = float_of_string ;;

let norm_to_string = string_of_float ;;

let norm_print = print_float ;;

let norm_eq = ( = ) ;;

let norm_eq_zero = ( = ) 0. ;;

let norm_compare = fun (x:u) (y:u) -> ((Pervasives.compare x y):int) ;;

let norm_add = ( +. ) ;;

let norm_int_mult = fun (x:int) (y:u) -> ( float x ) *. y ;;

let norm_mult = ( *. ) ;;

let norm_square = function x -> x *. x ;;

let zero = function () -> Array.make_matrix 2 2 0. ;;

let one = function () -> Matrix.identity_float 2 2 ;;

let of_string = Matrix.matrix_float_of_string

let to_string = Matrix.matrix_float_to_string

let print = Matrix.matrix_float_print ;;

let copy = Matrix.matrix_float_copy ;;

let eq_zero = function x -> Reduc.complex_square_module x == 0. ;;

let eq = fun x y -> eq_zero ( Matrix.matrix_float_minus x y ) ;;

let eq_one = eq ( one () ) ;;

let compare = fun x y -> compare ( Reduc.complex_square_module x ) ( Reduc.complex_square_module y ) ;;

let norm = Reduc.complex_module ;;

let opp = Matrix.matrix_float_opp ;;

let add = Matrix.matrix_float_plus ;;

let sub = Matrix.matrix_float_minus ;;

let int_mult = fun x y -> Matrix.matrix_float_scal_mult ( float x ) y ;;

let mult = Matrix.matrix_float_prod ;;

let square = fun x -> mult x x ;;

let inv = Reduc.complex_inv ;;

let div = Reduc.complex_div ;;

let int_div = fun x y -> Matrix.matrix_float_scal_left_div ( float x ) y ;;

let int_pow = Matrix.float_power ;;



end ;;









module Sci_bare_coeff = struct



include Sci ;;

open Sci ;;



type t = Num.num array ;;

type u = Num.num array ;;

type v = t ;;

let norm_inject = function (x:t) -> (x:v) ;;

let zero = function () -> Sci.sci_0 ;;

let one = function () -> Sci.sci_1 ;;

let of_string = Sci.sci_of_string ;;

let to_string = Sci.sci_to_string ;;

let print = function x ->

 begin

  let s = Sci.sci_to_string_array x in

   print_string ( s.(0) ^ "\n" ) ;

   print_string ( s.(1) ^ "\n" ) ;

   print_string s.(2)

 end

let copy = Sci.sci_copy ;;

let eq_zero = Sci.eq_0 ;;

let eq = Sci.eq ;;

let eq_one = eq ( one () ) ;;

let compare = fun x y ->

 begin

  let xx = Sci.square_module x

  and yy = Sci.square_module y in

   let z = Sci.minus xx yy in

    Num.compare_num Sci.num_0 z.(0)

 end ;;

let norm = Sci.square_module ;;

let add = Sci.plus ;;

let sub = Sci.minus ;;

let square = function x -> mult x x ;;

let int_div = fun x y -> div y ( sci_of_int x ) ;;

let int_mult = fun x y -> mult ( sci_of_int x ) y ;;



end ;;







module Sci_coeff = Data.Normalize_field_coefficient (Sci_bare_coeff) (Sci_bare_coeff) ;;







module Sci_1024_bare_coeff = struct



include Sci ;;



type t = Num.num array ;;

type u = Num.num array ;;

type v = t

let norm_inject = function (x:t) -> (x:v) ;;

let zero = function () -> Sci.sci_0 ;;

let one = function () -> Sci.sci_1 ;;

let of_string = Sci.sci_of_string ;;

let to_string = Sci.sci_to_string ;;

let print = Sci.print_sci_1024_10 ;;

let copy = Sci.sci_copy ;;

let eq_zero = eq_0_1024 ;;

let eq = Sci.eq ;;

let eq_one = eq ( one () ) ;;

let compare = fun x y ->

 begin

  let xx = Sci.square_module x

  and yy = Sci.square_module y in

   let z = Sci.minus_1024 xx yy in

    Num.compare_num Sci.num_0 z.(0)

 end ;;

let norm = Sci.module_1024 ;;

let add = Sci.plus_1024 ;;

let sub = Sci.minus_1024 ;;

let mult = Sci.mult_1024 ;;

let square = function x -> mult x x ;;

let int_mult = fun x y -> mult_1024 ( sci_of_int x ) y ;;

let inv = Sci.inv_1024 ;;

let div = Sci.div_1024 ;;

let int_div = fun x y -> div_1024 y ( sci_of_int x ) ;;

let int_pow = Sci.int_pow_1024 ;;



end ;;







module Sci_1024_coeff = Data.Normalize_field_coefficient (Sci_1024_bare_coeff) (Sci_1024_bare_coeff) ;;













end ;;